#Librerias necesarias.
if (!require("VIM")) {
install.packages("VIM")
}## Loading required package: VIM## Loading required package: colorspace## Loading required package: grid## VIM is ready to use.## Suggestions and bug-reports can be submitted at: https://github.com/statistikat/VIM/issues##
## Attaching package: 'VIM'## The following object is masked from 'package:datasets':
##
## sleepif (!require("missForest")) {
install.packages("missForest")
}## Loading required package: missForest##
## Attaching package: 'missForest'## The following object is masked from 'package:VIM':
##
## nrmseif (!require("plotly")) {
install.packages("plotly")
}## Loading required package: plotly## Loading required package: ggplot2##
## Attaching package: 'plotly'## The following object is masked from 'package:ggplot2':
##
## last_plot## The following object is masked from 'package:stats':
##
## filter## The following object is masked from 'package:graphics':
##
## layoutif (!require("tidyverse")) {
install.packages("tidyverse")
}## Loading required package: tidyverse## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr 1.1.4 ✔ readr 2.1.4
## ✔ forcats 1.0.0 ✔ stringr 1.5.0
## ✔ lubridate 1.9.2 ✔ tibble 3.2.1
## ✔ purrr 1.0.1 ✔ tidyr 1.3.0
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks plotly::filter(), stats::filter()
## ✖ dplyr::lag() masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errorsif (!require("lubridate")) {
install.packages("lubridate")
}
if (!require("ggeffects")) {
install.packages("ggeffects")
}## Loading required package: ggeffectsif (!require("sjPlot")) {
install.packages("sjPlot")
}## Loading required package: sjPlot
##
## Attaching package: 'sjPlot'
##
## The following object is masked from 'package:ggplot2':
##
## set_themeif (!require("tinytex")) {
install.packages("tinytex")
}## Loading required package: tinytexlibrary(dplyr)
library(lubridate)
library(ggplot2)
library(scales)##
## Attaching package: 'scales'
##
## The following object is masked from 'package:purrr':
##
## discard
##
## The following object is masked from 'package:readr':
##
## col_factorlibrary(plotly)
library(tidyverse)
library(lubridate)
library(missForest)
library(VIM)
library(corrplot)## corrplot 0.95 loadedlibrary(reshape2)##
## Attaching package: 'reshape2'
##
## The following object is masked from 'package:tidyr':
##
## smithslibrary(lme4)## Loading required package: Matrix
##
## Attaching package: 'Matrix'
##
## The following objects are masked from 'package:tidyr':
##
## expand, pack, unpacklibrary(quantreg)## Loading required package: SparseM
##
## Attaching package: 'SparseM'
##
## The following object is masked from 'package:base':
##
## backsolvelibrary(ggeffects)
library(sjPlot)
library(plotly)
library(performance)
library(shiny)
library(mgcv)## Loading required package: nlme
##
## Attaching package: 'nlme'
##
## The following object is masked from 'package:lme4':
##
## lmList
##
## The following object is masked from 'package:dplyr':
##
## collapse
##
## This is mgcv 1.8-42. For overview type 'help("mgcv-package")'.#remove.packages("devtools")
#installed.packages()# Activities_AN <- read.csv("~TrailAnalytics/Datos/Exportacion_noviembre/activities_12005698.csv",
# stringsAsFactor=TRUE, sep=",")
# Activities_BC <- read.csv("~TrailAnalytics/Datos/Exportacion_noviembre/activities_39779781.csv",
# stringsAsFactor=TRUE, sep=",")
# Activities_IB <- read.csv("~TrailAnalytics/Datos/Exportacion_noviembre/activities_57717801.csv",
# stringsAsFactor=TRUE, sep=",")
# Activities_JA <- read.csv("~TrailAnalytics/Datos/Exportacion_noviembre/activities_106331448.csv",
# stringsAsFactor=TRUE, sep=",")
# Activities_JP <- read.csv("~TrailAnalytics/Datos/Exportacion_noviembre/activities_21875774.csv",
# stringsAsFactor=TRUE, sep=",")
# Activities_LJ <- read.csv("~TrailAnalytics/Datos/Exportacion_noviembre/activities_63055946.csv",
# stringsAsFactor=TRUE, sep=",")
# Activities_MB <- read.csv("~TrailAnalytics/Datos/Exportacion_noviembre/activities_73163720.csv",
# stringsAsFactor=TRUE, sep=",")
# Activities_NC <- read.csv("~TrailAnalytics/Datos/Exportacion_noviembre/activities_36944607.csv",
# stringsAsFactor=TRUE, sep=",")
# Activities_NP <- read.csv("~TrailAnalytics/Datos/Exportacion_noviembre/activities_49973975.csv",
# stringsAsFactor=TRUE, sep=",")
# Activities_RC <- read.csv("~TrailAnalytics/Datos/Exportacion_noviembre/activities_21939621.csv",
# stringsAsFactor=TRUE, sep=",")
# Activities_VS <- read.csv("~TrailAnalytics/Datos/Exportacion_noviembre/activities_85112912.csv",
# stringsAsFactor=TRUE, sep=",")
# Carpeta de datos dentro del proyecto (ruta relativa)
base_dir <- file.path("Datos", "Exportacion_noviembre")
files_activities <- c(
"activities_12005698.csv",
"activities_39779781.csv",
"activities_57717801.csv",
"activities_106331448.csv",
"activities_21875774.csv",
"activities_63055946.csv",
"activities_73163720.csv",
"activities_36944607.csv",
"activities_49973975.csv",
"activities_21939621.csv",
"activities_85112912.csv"
)
paths_activities <- file.path(base_dir, files_activities)
read_one <- function(p) read.csv(p, stringsAsFactors = TRUE, sep = ",")
Activities_AN <- read_one(paths_activities[1])
Activities_BC <- read_one(paths_activities[2])
Activities_IB <- read_one(paths_activities[3])
Activities_JA <- read_one(paths_activities[4])
Activities_JP <- read_one(paths_activities[5])
Activities_LJ <- read_one(paths_activities[6])
Activities_MB <- read_one(paths_activities[7])
Activities_NC <- read_one(paths_activities[8])
Activities_NP <- read_one(paths_activities[9])
Activities_RC <- read_one(paths_activities[10])
Activities_VS <- read_one(paths_activities[11])# Profile_AN <- read.csv("~TrailAnalytics/Datos/Exportacion_noviembre/profile_12005698.csv",
# stringsAsFactor=TRUE, sep=",")
# Profile_BC <- read.csv("~TrailAnalytics/Datos/Exportacion_noviembre/profile_39779781.csv",
# stringsAsFactor=TRUE, sep=",")
# Profile_IB <- read.csv("~TrailAnalytics/Datos/Exportacion_noviembre/profile_57717801.csv",
# stringsAsFactor=TRUE, sep=",")
# Profile_JA <- read.csv("~TrailAnalytics/Datos/Exportacion_noviembre/profile_106331448.csv",
# stringsAsFactor=TRUE, sep=",")
# Profile_JP <- read.csv("~TrailAnalytics/Datos/Exportacion_noviembre/profile_21875774.csv",
# stringsAsFactor=TRUE, sep=",")
# Profile_LJ <- read.csv("~TrailAnalytics/Datos/Exportacion_noviembre/profile_63055946.csv",
# stringsAsFactor=TRUE, sep=",")
# Profile_MB <- read.csv("~TrailAnalytics/Datos/Exportacion_noviembre/profile_73163720.csv",
# stringsAsFactor=TRUE, sep=",")
# Profile_NC <- read.csv("~TrailAnalytics/Datos/Exportacion_noviembre/profile_36944607.csv",
# stringsAsFactor=TRUE, sep=",")
# Profile_NP <- read.csv("~TrailAnalytics/Datos/Exportacion_noviembre/profile_49973975.csv",
# stringsAsFactor=TRUE, sep=",")
# Profile_RC <- read.csv("~TrailAnalytics/Datos/Exportacion_noviembre/profile_21939621.csv",
# stringsAsFactor=TRUE, sep=",")
# Profile_VS <- read.csv("~TrailAnalytics/Datos/Exportacion_noviembre/profile_85112912.csv",
# stringsAsFactor=TRUE, sep=",")
files_profile <- c(
"profile_12005698.csv",
"profile_39779781.csv",
"profile_57717801.csv",
"profile_106331448.csv",
"profile_21875774.csv",
"profile_63055946.csv",
"profile_73163720.csv",
"profile_36944607.csv",
"profile_49973975.csv",
"profile_21939621.csv",
"profile_85112912.csv"
)
paths_profile <- file.path(base_dir, files_profile)
read_one <- function(p) read.csv(p, stringsAsFactors = TRUE, sep = ",")
Profile_AN <- read_one(paths_profile[1])
Profile_BC <- read_one(paths_profile[2])
Profile_IB <- read_one(paths_profile[3])
Profile_JA <- read_one(paths_profile[4])
Profile_JP <- read_one(paths_profile[5])
Profile_LJ <- read_one(paths_profile[6])
Profile_MB <- read_one(paths_profile[7])
Profile_NC <- read_one(paths_profile[8])
Profile_NP <- read_one(paths_profile[9])
Profile_RC <- read_one(paths_profile[10])
Profile_VS <- read_one(paths_profile[11])#summary(Activities_JA)
structure_Activities = str(Activities_JA)## 'data.frame': 897 obs. of 99 variables:
## $ Activity.ID : num 7.95e+09 7.98e+09 8.00e+09 8.04e+09 8.05e+09 ...
## $ Activity.Date : Factor w/ 897 levels "Apr 1, 2024, 8:17:29 AM",..: 757 772 789 815 690 737 740 747 694 697 ...
## $ Activity.Name : Factor w/ 284 levels "¿Algú ha dit humitat?💧💧",..: 159 159 159 205 43 137 42 159 43 206 ...
## $ Activity.Type : Factor w/ 6 levels "Hike","Ride",..: 3 3 3 3 3 3 3 3 3 3 ...
## $ Activity.Description : Factor w/ 490 levels "","(⬆️ en Z2 ⬇️ en Z1 ) x4\nUn poc cansat d’ ahir 😅💪🏻",..: 1 1 1 1 1 1 1 1 1 1 ...
## $ Elapsed.Time : int 2823 3576 4430 8420 7071 7058 13799 2970 4248 8255 ...
## $ Distance : num 10.04 12 15.39 9.82 9.16 ...
## $ Max.Heart.Rate : num NA NA NA NA NA NA NA NA NA NA ...
## $ Relative.Effort : int NA NA NA NA NA NA NA NA NA NA ...
## $ Commute : Factor w/ 1 level "false": 1 1 1 1 1 1 1 1 1 1 ...
## $ Activity.Private.Note : Factor w/ 33 levels "","110 gen / 33 cat.",..: 1 1 1 1 1 1 1 1 1 1 ...
## $ Activity.Gear : Factor w/ 13 levels "","ASICS novablast 5 🟣🟠",..: 1 1 1 9 9 9 9 1 1 9 ...
## $ Filename : Factor w/ 894 levels "","activities/10038056227.fit.gz",..: 777 778 779 780 781 782 783 784 785 786 ...
## $ Athlete.Weight : logi NA NA NA NA NA NA ...
## $ Bike.Weight : logi NA NA NA NA NA NA ...
## $ Elapsed.Time.1 : num 2823 3576 4430 8420 7071 ...
## $ Moving.Time : num 2816 3572 4427 6104 4616 ...
## $ Distance.1 : num 10043 12007 15398 9823 9161 ...
## $ Max.Speed : num 4.59 5.34 5.02 5.58 6.88 ...
## $ Average.Speed : num 3.57 3.36 3.48 1.61 1.99 ...
## $ Elevation.Gain : num 8.6 21.2 12.1 683.7 483.6 ...
## $ Elevation.Loss : num 9.5 23.3 11.5 702.4 486.3 ...
## $ Elevation.Low : num 18.5 15.2 5.5 19.4 131.9 ...
## $ Elevation.High : num 22.9 19.2 17.6 619.8 572.6 ...
## $ Max.Grade : num 32.7 3.8 4.2 49.5 49.4 45.6 49.5 3.4 3.6 50 ...
## $ Average.Grade : num 0 0 0 -0.2 0 0 3.9 0 0 -0.1 ...
## $ Average.Positive.Grade : logi NA NA NA NA NA NA ...
## $ Average.Negative.Grade : logi NA NA NA NA NA NA ...
## $ Max.Cadence : num NA NA NA NA NA NA NA NA NA NA ...
## $ Average.Cadence : num NA NA NA NA NA NA NA NA NA NA ...
## $ Max.Heart.Rate.1 : num NA NA NA NA NA NA NA NA NA NA ...
## $ Average.Heart.Rate : num NA NA NA NA NA NA NA NA NA NA ...
## $ Max.Watts : logi NA NA NA NA NA NA ...
## $ Average.Watts : num NA NA NA NA NA NA NA NA NA NA ...
## $ Calories : num 662 798 1015 1082 896 ...
## $ Max.Temperature : logi NA NA NA NA NA NA ...
## $ Average.Temperature : num NA NA NA NA NA NA NA NA NA NA ...
## $ Relative.Effort.1 : num NA NA NA NA NA NA NA NA NA NA ...
## $ Total.Work : num NA NA NA NA NA NA NA NA NA NA ...
## $ Number.of.Runs : logi NA NA NA NA NA NA ...
## $ Uphill.Time : logi NA NA NA NA NA NA ...
## $ Downhill.Time : logi NA NA NA NA NA NA ...
## $ Other.Time : logi NA NA NA NA NA NA ...
## $ Perceived.Exertion : num NA NA NA NA NA NA 6 NA NA NA ...
## $ Type : logi NA NA NA NA NA NA ...
## $ Start.Time : logi NA NA NA NA NA NA ...
## $ Weighted.Average.Power : num NA NA NA NA NA NA NA NA NA NA ...
## $ Power.Count : num NA NA NA NA NA NA NA NA NA NA ...
## $ Prefer.Perceived.Exertion : num NA NA NA 0 0 0 0 0 NA 0 ...
## $ Perceived.Relative.Effort : num NA NA NA NA NA NA 276 NA NA NA ...
## $ Commute.1 : num 0 0 0 0 0 0 0 0 0 0 ...
## $ Total.Weight.Lifted : logi NA NA NA NA NA NA ...
## $ From.Upload : num 1 1 1 1 1 1 1 1 1 1 ...
## $ Grade.Adjusted.Distance : num 10040 12036 15410 14352 12232 ...
## $ Weather.Observation.Time : num NA NA NA NA NA NA NA NA NA NA ...
## $ Weather.Condition : num NA NA NA NA NA NA NA NA NA NA ...
## $ Weather.Temperature : num NA NA NA NA NA NA NA NA NA NA ...
## $ Apparent.Temperature : num NA NA NA NA NA NA NA NA NA NA ...
## $ Dewpoint : num NA NA NA NA NA NA NA NA NA NA ...
## $ Humidity : num NA NA NA NA NA NA NA NA NA NA ...
## $ Weather.Pressure : num NA NA NA NA NA NA NA NA NA NA ...
## $ Wind.Speed : num NA NA NA NA NA NA NA NA NA NA ...
## $ Wind.Gust : num NA NA NA NA NA NA NA NA NA NA ...
## $ Wind.Bearing : num NA NA NA NA NA NA NA NA NA NA ...
## $ Precipitation.Intensity : num NA NA NA NA NA NA NA NA NA NA ...
## $ Sunrise.Time : num NA NA NA NA NA NA NA NA NA NA ...
## $ Sunset.Time : num NA NA NA NA NA NA NA NA NA NA ...
## $ Moon.Phase : num NA NA NA NA NA NA NA NA NA NA ...
## $ Bike : logi NA NA NA NA NA NA ...
## $ Gear : num NA NA NA 13751513 13751513 ...
## $ Precipitation.Probability : num NA NA NA NA NA NA NA NA NA NA ...
## $ Precipitation.Type : num NA NA NA NA NA NA NA NA NA NA ...
## $ Cloud.Cover : num NA NA NA NA NA NA NA NA NA NA ...
## $ Weather.Visibility : num NA NA NA NA NA NA NA NA NA NA ...
## $ UV.Index : num NA NA NA NA NA NA NA NA NA NA ...
## $ Weather.Ozone : logi NA NA NA NA NA NA ...
## $ Jump.Count : logi NA NA NA NA NA NA ...
## $ Total.Grit : logi NA NA NA NA NA NA ...
## $ Average.Flow : logi NA NA NA NA NA NA ...
## $ Flagged : num 0 0 0 0 0 0 0 0 0 0 ...
## $ Average.Elapsed.Speed : num 3.56 3.36 3.48 1.17 1.3 ...
## $ Dirt.Distance : num 8827 0 8746 7814 5335 ...
## $ Newly.Explored.Distance : logi NA NA NA NA NA NA ...
## $ Newly.Explored.Dirt.Distance: logi NA NA NA NA NA NA ...
## $ Activity.Count : logi NA NA NA NA NA NA ...
## $ Total.Steps : num NA NA NA NA NA NA NA NA NA NA ...
## $ Carbon.Saved : num NA NA NA NA NA NA NA NA NA NA ...
## $ Pool.Length : logi NA NA NA NA NA NA ...
## $ Training.Load : num NA NA NA NA NA NA NA NA NA NA ...
## $ Intensity : num NA NA NA NA NA NA NA NA NA NA ...
## $ Average.Grade.Adjusted.Pace : num NA NA NA NA NA NA NA NA NA NA ...
## $ Timer.Time : logi NA NA NA NA NA NA ...
## $ Total.Cycles : logi NA NA NA NA NA NA ...
## $ Recovery : num NA NA NA NA NA NA NA NA NA NA ...
## $ With.Pet : logi NA NA NA NA NA NA ...
## $ Competition : logi NA NA NA NA NA NA ...
## $ Long.Run : logi NA NA NA NA NA NA ...
## $ For.a.Cause : logi NA NA NA NA NA NA ...
## $ Media : Factor w/ 139 levels "","media/00367516-B203-4B39-8702-CD945CE4B384.jpg",..: 1 1 1 1 1 57 126 1 1 1 ...#summary(Activities_JA)
structure_Profile = str(Profile_JA)## 'data.frame': 1 obs. of 12 variables:
## $ Athlete.ID : int 106331448
## $ Email.Address : Factor w/ 1 level "JA@hotmail.com": 1
## $ First.Name : Factor w/ 1 level "J ": 1
## $ Last.Name : Factor w/ 1 level "A": 1
## $ Sex : Factor w/ 1 level "Male": 1
## $ Description : Factor w/ 1 level "Trust the process 💪🏻🤙🏼🏔️": 1
## $ Weight : num 70.5
## $ City : Factor w/ 1 level "Algemesí": 1
## $ State : Factor w/ 1 level "València": 1
## $ Country : logi NA
## $ Health.Consent.Status : Factor w/ 1 level "Approved": 1
## $ Date.of.Health.Consent.approval.denial: Factor w/ 1 level "May 5, 2023, 6:33:00 AM": 1Tal y como podemos ver, tomamos como base del presente estudio dos datatsets, el primero relacionado con las actividades practicadas por cada atleta donde localizamos cerca de 100 dimensiones o columnas disponibles, estas versan sobre métricas fisiológicas básicas y avanzadas. Por su parte, el segundo es simplemente la información principal del perfil del corredor, siendo poseedor de 12 columnas.Todo y que de este último no vamos a utilizar ningún dato que pueda identificar o comprometer visiblemente al atleta, velando por una mayor seguridad de los datos a la hora de tratarlos desde este entorno,hemos obtado por anonimizarlo mediante uso de pseudónimos.
Contamos entonces con un conjunto de 11 datasets de activities y 11 de profile procedentes de 11 corredores (incluido yo) correspondientes a ambos géneros (7 hombres y 4 mujeres), los cuales vamos a proceder a tratar y fusionar en uno para su posterior análisis.Con ello, se consigue información de distintos tipos de corredores, esto es, corredores de corta, media e incluso ultradistancia y además incluyendo peculiaridades y retos asociados que han desempeñado durante estos años.
Tras una primera inspección de los datasets notamos que el nombre de las columnas están en distinto idioma para algunos corredores.
#Generamos una estructura para establecer este mapeo en ambos datasets.
mapping_Activities_Type_es_en <- c(
"ID.de.actividad" = "Activity.ID",
"Fecha.de.la.actividad" = "Activity.Date",
"Nombre.de.la.actividad" = "Activity.Name",
"Tipo.de.actividad" = "Activity.Type",
"Descripción.de.la.actividad" = "Activity.Description",
"Tiempo.transcurrido" = "Elapsed.Time",
"Distancia" = "Distance",
"Ritmo.cardiaco.máximo" = "Max.Heart.Rate",
"Esfuerzo.Relativo" = "Relative.Effort",
"Desplazamiento" = "Commute",
"Nota.privada.de.actividad" = "Activity.Private.Note",
"Equipamiento.de.la.actividad" = "Activity.Gear",
"Nombre.del.archivo" = "Filename",
"Peso.del.deportista" = "Athlete.Weight",
"Peso.de.la.bicicleta" = "Bike.Weight",
"Tiempo.transcurrido.1" = "Elapsed.Time.1",
"Tiempo.en.movimiento" = "Moving.Time",
"Distancia.1" = "Distance.1",
"Velocidad.máxima" = "Max.Speed",
"Velocidad.promedio" = "Average.Speed",
"Desnivel.positivo" = "Elevation.Gain",
"Desnivel.negativo" = "Elevation.Loss",
"Desnivel.bajo" = "Elevation.Low",
"Desnivel.alto" = "Elevation.High",
"Pendiente.máxima" = "Max.Grade",
"Pendiente.promedio" = "Average.Grade",
"Pendiente.positiva.promedio" = "Average.Positive.Grade",
"Pendiente.negativa.promedio" = "Average.Negative.Grade",
"Cadencia.máx." = "Max.Cadence",
"Cadencia.promedio" = "Average.Cadence",
"Ritmo.cardiaco.máximo.1" = "Max.Heart.Rate.1",
"Ritmo.cardiaco.promedio" = "Average.Heart.Rate",
"Vatios.máx." = "Max.Watts",
"Vatios.promedio" = "Average.Watts",
"Calorías" = "Calories",
"Temperatura.máx." = "Max.Temperature",
"Temperatura.promedio" = "Average.Temperature",
"Esfuerzo.Relativo.1" = "Relative.Effort.1",
"Trabajo.total" = "Total.Work",
"Número.de.carreras" = "Number.of.Runs",
"Tiempo.en.ascenso" = "Uphill.Time",
"Tiempo.en.descenso" = "Downhill.Time",
"Otro.tiempo" = "Other.Time",
"Esfuerzo.Percibido" = "Perceived.Exertion",
"Tipo" = "Type",
"Hora.de.inicio" = "Start.Time",
"Potencia.promedio.ponderada" = "Weighted.Average.Power",
"Recuento.de.potencia" = "Power.Count",
"Usar.Esfuerzo.Percibido" = "Prefer.Perceived.Exertion",
"Esfuerzo.Relativo.percibido" = "Perceived.Relative.Effort",
"Desplazamiento.1" = "Commute.1",
"Peso.total.levantado" = "Total.Weight.Lifted",
"Desde.la.carga" = "From.Upload",
"Distancia.ajustada.en.pendientes" = "Grade.Adjusted.Distance",
"Hora.de.observación.meteorológica" = "Weather.Observation.Time",
"Condición.meteorológica" = "Weather.Condition",
"Temperatura.meteorológica" = "Weather.Temperature",
"Temperatura.aparente" = "Apparent.Temperature",
"Punto.de.rocío" = "Dewpoint",
"Humedad" = "Humidity",
"Presión.meteorológica" = "Weather.Pressure",
"Velocidad.del.viento" = "Wind.Speed",
"Ráfaga.de.viento" = "Wind.Gust",
"Dirección.del.viento" = "Wind.Bearing",
"Intensidad.de.precipitación" = "Precipitation.Intensity",
"Hora.del.amanecer" = "Sunrise.Time",
"Hora.del.atardecer" = "Sunset.Time",
"Fase.lunar" = "Moon.Phase",
"Bicicleta" = "Bike",
"Equipamiento" = "Gear",
"Probabilidad.de.precipitación" = "Precipitation.Probability",
"Tipo.de.precipitación" = "Precipitation.Type",
"Nubosidad" = "Cloud.Cover",
"Visibilidad.meteorológica" = "Weather.Visibility",
"Índice.UV" = "UV.Index",
"Ozono.meteorológico" = "Weather.Ozone",
"Recuento.de.saltos" = "Jump.Count",
"Grit.total" = "Total.Grit",
"Flow.promedio" = "Average.Flow",
"Denunciado" = "Flagged",
"Velocidad.promedio.durante.el.tiempo.transcurrido" = "Average.Elapsed.Speed",
"Distancia.en.tierra" = "Dirt.Distance",
"Distancia.recientemente.explorada" = "Newly.Explored.Distance",
"Distancia.en.rampas.de.tierra.recientemente.explorada" = "Newly.Explored.Dirt.Distance",
"Recuento.de.actividades" = "Activity.Count",
"Total.de.pasos" = "Total.Steps",
"Ahorro.en.carbono" = "Carbon.Saved",
"Largo.de.la.piscina" = "Pool.Length",
"Carga.de.entrenamiento" = "Training.Load",
"Intensidad" = "Intensity",
"Ritmo.ajustado.en.pendientes.promedio" = "Average.Grade.Adjusted.Pace",
"Tiempo.cronometrado" = "Timer.Time",
"Ciclos.en.total" = "Total.Cycles",
"Recuperación" = "Recovery",
"Con.mascota" = "With.Pet",
"Competición" = "Competition",
"Carrera.de.larga.distancia" = "Long.Run",
"Por.una.causa" = "For.a.Cause",
"Multimedia" = "Media"
)
mapping_Profile_es_en <- c(
"ID.de.deportista" = "Athlete.ID",
"Dirección.de.correo" = "Email.Address",
"Nombre" = "First.Name",
"Apellidos" = "Last.Name",
"Género" = "Sex",
"Descripción" = "Description",
"Peso" = "Weight",
"Ciudad" = "City",
"Provincia" = "State",
"País" = "Country",
"Estado.del.consentimiento.sanitario" = "Health.Consent.Status",
"Fecha.de.aprobación.denegación.del.consentimiento.sanitario"
= "Date.of.Health.Consent.approval.denial"
)
# Renombrar dataset Activities y mapear algunas de sus columnas.
#Generamos lista con datasets a renombrar.
list_Activities_E <- list(
Activities_RC, Activities_NC, Activities_MB, Activities_JP, Activities_BC,
Activities_AN
)
#Generamos función para renombrarlo y mapearlo.
rename_with_map <- function(df, map) {
names(df) <- ifelse(
names(df) %in% names(map),
map[names(df)],
names(df)
)
return(df)
}
#Aplicamos función anterior sobre la lista de ficheros de actividades erróneos.
list_Activities_renamed <- lapply(list_Activities_E, rename_with_map,
map = mapping_Activities_Type_es_en)
#Rescatamos los datasets correspondientes.
Activities_RC <- list_Activities_renamed[[1]]
Activities_NC <- list_Activities_renamed[[2]]
Activities_MB <- list_Activities_renamed[[3]]
Activities_JP <- list_Activities_renamed[[4]]
Activities_BC <- list_Activities_renamed[[5]]
Activities_AN <- list_Activities_renamed[[6]]
# Renombrar dataset Profile
#Generamos lista con datasets a renombrar.
list_Profile_E <- list(
Profile_RC, Profile_NC,Profile_MB, Profile_JP, Profile_BC,
Profile_AN
)
#Aplicamos función anterior sobre la lista de ficheros de actividades erróneas.
list_Profile_renamed <- lapply(list_Profile_E, rename_with_map,
map = mapping_Profile_es_en)
#Rescatamos los datasets correspondientes.
Profile_RC <- list_Profile_renamed[[1]]
Profile_NC <- list_Profile_renamed[[2]]
Profile_MB <- list_Profile_renamed[[3]]
Profile_JP <- list_Profile_renamed[[4]]
Profile_BC <- list_Profile_renamed[[5]]
Profile_AN <- list_Profile_renamed[[6]]Además también debemos de traducir el contenido de algunas columnas de ambos datasets, como la columna Tipo de actividad, fecha o Sex o incluso las variables decimales, las cuales tendrán separadores distintos “.” o “,”.Procedemos bajo la misma operativa utilizada anteriormente.
#Mapeo de actividades
Activities_Types_map <- c(
"Bicicleta" = "Ride",
"Bicicleta virtual" = "Virtual Ride",
"Caminata" = "Walk",
"Carrera" = "Run",
"Crossfit" = "Crossfit",
"Elíptica" = "Elliptical",
"Entrenamiento" = "Workout",
"Entrenamiento con pesas" = "Weight Training",
"Escalada" = "Climbing",
"Escaleras" = "Stairs",
"Kayak" = "Kayaking",
"Esquí de fondo" = "Cross-country Skiing",
"Natación" = "Swimming",
"Raquetas de nieve" = "Snowshoeing",
"Senderismo" = "Hike",
"Snowboard" = "Snowboarding",
"Surf" = "Surfing",
"Surf de remo" = "Stand-up Paddleboarding",
"Yoga" = "Yoga"
)
Activities_Type_T <- lapply(list_Activities_renamed, function(df) {
df$Activity.Type <- ifelse(trimws (df$Activity.Type) %in% trimws(names(Activities_Types_map)),
Activities_Types_map[trimws(df$Activity.Type)],
df$Activity.Type)
df
})
# Rescatamos los datasets correspondientes.
Activities_RC <- Activities_Type_T[[1]]
Activities_NC <- Activities_Type_T[[2]]
Activities_MB <- Activities_Type_T[[3]]
Activities_JP <- Activities_Type_T[[4]]
Activities_BC <- Activities_Type_T[[5]]
Activities_AN <- Activities_Type_T[[6]]
#Traducimos la columna Género para el dataset "Profile"
Profile_Sex_map <- c(
"Hombre" = "Male",
"Mujer" = "Female"
)
Profile_Sex_T <- lapply(list_Profile_renamed, function(df) {
df$Sex <- ifelse(trimws(df$Sex) %in% trimws(names(Profile_Sex_map)),
Profile_Sex_map[trimws(df$Sex)],
df$Sex)
df
})
# Rescatamos los datasets correspondientes.
Profile_RC <- Profile_Sex_T[[1]]
Profile_NC <- Profile_Sex_T[[2]]
Profile_MB <- Profile_Sex_T[[3]]
Profile_JP <- Profile_Sex_T[[4]]
Profile_BC <- Profile_Sex_T[[5]]
Profile_AN <- Profile_Sex_T[[6]]
#Unificamos formato de los valores decimales que tengan el separadaor "," y no "." para el campo Distancia.
Activities_RC[["Distance"]] <- as.numeric(gsub(",", ".", Activities_RC[["Distance"]]))
Activities_NC[["Distance"]] <- as.numeric(gsub(",", ".", Activities_NC[["Distance"]]))
Activities_MB[["Distance"]] <- as.numeric(gsub(",", ".", Activities_MB[["Distance"]]))
Activities_JP[["Distance"]] <- as.numeric(gsub(",", ".", Activities_JP[["Distance"]]))
Activities_BC[["Distance"]] <- as.numeric(gsub(",", ".", Activities_BC[["Distance"]]))
Activities_AN[["Distance"]] <- as.numeric(gsub(",", ".", Activities_AN[["Distance"]]))Otro aspecto que deberemos de tener en cuenta previo a la integración es la unificación del formato de la fecha para ambos datasets.
# Definimos funciones de conversión
convert_format_english <- function(x) {
x <- trimws(x) #Posibles espacios
x <- gsub("\\s+", " ", x) #Carácteres raros
dt <- mdy_hms(x, locale = "en_US.UTF-8")
format(dt, "%d-%m-%Y, %H:%M:%S")
}
convert_format_spanish <- function(x) {
x <- trimws(x) #Posibles espacios
x <- gsub("\\s+", " ", x) #Carácteres raros
dt <- dmy_hms(x, locale = "es_ES")
format(dt, "%d-%m-%Y, %H:%M:%S") # Formatear al formato solicitado
}
#Aplicación de las funciones de conversión entre los datasets correspondientes.
# lista_english -- formato "Oct 12, 2022, 5:10:15 PM". Aquí entrarán el resto de datasets no procesados anteriormente.
lista_english <- list(Activities_IB,Activities_JA,Activities_LJ,Activities_NP,Activities_VS)
for (i in seq_along(lista_english)) {
lista_english[[i]]$Activity.Date <- convert_format_english(lista_english[[i]]$Activity.Date)
}
# Rescatamos y sobreescribimos los datasets correspondientes.
Activities_IB <- lista_english[[1]]
Activities_JA <- lista_english[[2]]
Activities_LJ <- lista_english[[3]]
Activities_NP <- lista_english[[4]]
Activities_VS <- lista_english[[5]]
# lista_spanish -- formato "3 nov 2015, 9:15:59". Aquí entrarán los datasets que hemos procesado y renombrado anteriormente.
lista_spanish <- list(Activities_RC, Activities_NC, Activities_MB, Activities_JP, Activities_BC,
Activities_AN)
for (i in seq_along(lista_spanish)) {
lista_spanish[[i]]$Activity.Date <- convert_format_spanish(lista_spanish[[i]]$Activity.Date)
}
# Rescatamos y sobreescribimos los datasets correspondientes.
Activities_RC <- lista_spanish[[1]]
Activities_NC <- lista_spanish[[2]]
Activities_MB <- lista_spanish[[3]]
Activities_JP <- lista_spanish[[4]]
Activities_BC <- lista_spanish[[5]]
Activities_AN <- lista_spanish[[6]]Añadimos la columna con el identificador único del corredor que conocemos el cual nos servirá de enlace para el otro fichero.
Activities_AN$Athlete.ID <- 12005698
Activities_BC$Athlete.ID <- 39779781
Activities_IB$Athlete.ID <- 57717801
Activities_JA$Athlete.ID <- 106331448
Activities_JP$Athlete.ID <- 21875774
Activities_LJ$Athlete.ID <- 63055946
Activities_MB$Athlete.ID <- 73163720
Activities_NC$Athlete.ID <- 36944607
Activities_NP$Athlete.ID <- 49973975
Activities_RC$Athlete.ID <- 21939621
Activities_VS$Athlete.ID <- 85112912Integramos en el fichero de activities el género del corredor@
# Listas con datasets de actividades y de perfiles
Activities_list <- list(Activities_AN, Activities_BC, Activities_IB,Activities_JA,Activities_JP,Activities_LJ,Activities_MB,Activities_NC,Activities_NP,Activities_RC,Activities_VS)
Profiles_list <- list(Profile_AN, Profile_BC, Profile_IB,Profile_JA,Profile_JP,Profile_LJ,Profile_MB,Profile_NC,Profile_NP,Profile_RC,Profile_VS)
# Lista vacía para guardar resultados
merged_list <- vector("list", length(Activities_list))
# Iterar sobre todos los pares
for (i in seq_along(Activities_list)) {
merged_list[[i]] <- merge(
Activities_list[[i]],
Profiles_list[[i]][, c("Athlete.ID", "Sex")],
by = "Athlete.ID",
all.x = TRUE # mantiene todas las actividades
)
}
#Rescatamos los datasets correspondientes ya combinados.
ActivitiesCombined_AN <- merged_list[[1]]
ActivitiesCombined_BC <- merged_list[[2]]
ActivitiesCombined_IB <- merged_list[[3]]
ActivitiesCombined_JA <- merged_list[[4]]
ActivitiesCombined_JP <- merged_list[[5]]
ActivitiesCombined_LJ <- merged_list[[6]]
ActivitiesCombined_MB <- merged_list[[7]]
ActivitiesCombined_NC <- merged_list[[8]]
ActivitiesCombined_NP <- merged_list[[9]]
ActivitiesCombined_RC <- merged_list[[10]]
ActivitiesCombined_VS <- merged_list[[11]]Por último , una vez con todos los datasets alineados, los fusionamos en uno único para disponer de los datos unificados.
# Creamos lista con todos los datasets combinados.
CombinedDS_list <- list(ActivitiesCombined_AN, ActivitiesCombined_BC, ActivitiesCombined_IB, ActivitiesCombined_JA, ActivitiesCombined_JP, ActivitiesCombined_LJ, ActivitiesCombined_MB, ActivitiesCombined_NC, ActivitiesCombined_NP, ActivitiesCombined_RC, ActivitiesCombined_VS)
#Convertimos las columnas de tipo factor a tipo character para evitar problemas con el fusionado.
CombinedDS_list <- lapply(CombinedDS_list, function(df) {
df[] <- lapply(df, function(col) {
if (is.factor(col)) as.character(col)
else col
}
)
df
})
# Unimos o fusionamos los datasets mediante la llamada a la funcciónn rbind()
Activities_integred <- do.call(rbind, CombinedDS_list)
#Tras revisar el dataset fusionado notamos que una variable se nos ha quedado en tipo caracter, la pasamos a numérica.
Activities_integred$Distance <- as.numeric(Activities_integred$Distance)## Warning: NAs introduced by coercion1.- Existen datasets de corredores que han registrado actividades que no tienen relación directa/indirecta con la preparación para Trail Running: natacion, padel… Deberemos de excluirlas.
#Mostramos los tipos actuales.
unique(Activities_integred$Activity.Type )## [1] "Run" "Swimming"
## [3] "Workout" "Walk"
## [5] "Ride" "Cross-country Skiing"
## [7] "Hike" "Elliptical"
## [9] "Yoga" "Crossfit"
## [11] "Weight Training" "Stair-Stepper"
## [13] "Virtual Ride" "Kayaking"
## [15] "Stairs" "Swim"
## [17] "Stand Up Paddling" "Surfing"
## [19] "Stand-up Paddleboarding" "Snowboarding"
## [21] "Climbing" "Snowshoeing"#Generamos lista con las activiades a excluir.
Activity_Types_Excl <- list("Swimming","Yoga","Crossfit","Stair-Stepper","Kayaking","Stairs","Swim","Stand Up Paddling","Surfing","Stand-up Paddleboarding","Snowboarding","Climbing","Snowshoeing")
# Excluimos aquellas actividades relacionadas con deportes de raqueta como Pádel.
Activities_integred <- Activities_integred[!grepl("Pádel", Activities_integred$Activity.Name, ignore.case = TRUE), ]
# Excluimos actividades que no tengan que ver con el estudio.
Activities_integred <- Activities_integred[!(Activities_integred$Activity.Type %in% Activity_Types_Excl), ]2.- Deberemos de establecer dos criterios paras filtrar la información dispuesta.Cada dataset data de una fecha de inicio y fin de actividades distinta. A modo de estandarización vamos a establecer y quedarnos con el mismo rango de fechas para todos los datasets.
# Rango de fechas
start_date <- as.Date("2020-11-01")
end_date <- as.Date("2025-11-01")
#Convertimos Activity.Date a fecha-hora (eliminando la coma) para evitarnos problemas de conversión.
Activities_integred$ActivityDT <- parse_date_time(gsub(",", "", Activities_integred$Activity.Date),
orders = "dmy HMS")
#Creamos columna solo para fecha (tipo Date) y otra para la parte horaria.
Activities_integred$Activity.Date_Date <- as.Date(Activities_integred$ActivityDT)
Activities_integred$Activity.Date_Time <- format(Activities_integred$ActivityDT, "%H:%M:%S")
#Quitamos la columna intermedia. Ya no nos vale.
Activities_integred <- Activities_integred %>% select(-ActivityDT)
#Creamos un nuevo dataset resultante filtrado.
Activities_final_selected <- Activities_integred %>%
filter(Activity.Date_Date >= start_date, Activity.Date_Date <= end_date)#write.csv(Activities_final_Analysis, "Activities_final_Analysis.csv", row.names = FALSE)Deberemos de realizar un estudio de las columnas que disponemos y quedarnos sólamente con las que sean necesarias bajo el criterio de estudio , o bien estén en condiciones aceptables para este.
#Columnas excluidas bajo criterio de estudio.
cols_excl_CE <- c( "Activity.Name","Activity.Description","Commute","Activity.Private.Note","Filename","Bike.Weight","Elapsed.Time.1",
"Distance.1","Max.Heart.Rate.1","Relative.Effort.1","Number.of.Runs","Other.Time","Type","Commute.1","From.Upload",
"Grade.Adjusted.Distance","Sunrise.Time","Sunset.Time","Bike","Gear","Jump.Count","Total.Grit","Average.Flow",
"Flagged","Dirt.Distance","Newly.Explored.Distance","Newly.Explored.Dirt.Distance","Activity.Count","Carbon.Saved",
"Pool.Length","Total.Cycles","With.Pet","Competition","Long.Run","For.a.Cause","Media"
)
Activities_final_reduced <- Activities_final_selected[ , !(names(Activities_final_selected) %in% cols_excl_CE)]Vamos en busca de las distintos tipos de inconsistencias que nos podemos encontrar:
Estudiamos los valores vacíos o nulos en el conjunto de datos:
#Empleamos un dataframe a modo de tabla para estudiar el porcentaje de columnas vacías o nulas que existen.
table_NA_Empty <- data.frame(
Variable = names(Activities_final_reduced),
Total = sapply(Activities_final_reduced, function(x) length(x)),
NA_count = sapply(Activities_final_reduced, function(x) sum(is.na(x))),
Empty_count = sapply(Activities_final_reduced, function(x) sum(x == "", na.rm = TRUE))
#stringsAsFactors = FALSE
)
# Añadimos cálculo de porcentajes una vez calculados los totales.
table_NA_Empty$Pct_NA <- round(table_NA_Empty$NA_count / table_NA_Empty$Total * 100, 2)
table_NA_Empty$Pct_Empty <- round(table_NA_Empty$Empty_count / table_NA_Empty$Total * 100, 2)
rownames(table_NA_Empty) <- NULL #Quitamos los nombres de las columnas para que aparezcan números y sea más legible posteriormente.
table_NA_Empty## Variable Total NA_count Empty_count Pct_NA Pct_Empty
## 1 Athlete.ID 12954 0 0 0.00 0.00
## 2 Activity.ID 12954 0 0 0.00 0.00
## 3 Activity.Date 12954 0 0 0.00 0.00
## 4 Activity.Type 12954 0 0 0.00 0.00
## 5 Elapsed.Time 12954 0 0 0.00 0.00
## 6 Distance 12954 0 0 0.00 0.00
## 7 Max.Heart.Rate 12954 2778 0 21.45 0.00
## 8 Relative.Effort 12954 2778 0 21.45 0.00
## 9 Activity.Gear 12954 3851 4554 29.73 35.16
## 10 Athlete.Weight 12954 12954 0 100.00 0.00
## 11 Moving.Time 12954 0 0 0.00 0.00
## 12 Max.Speed 12954 163 0 1.26 0.00
## 13 Average.Speed 12954 0 0 0.00 0.00
## 14 Elevation.Gain 12954 116 0 0.90 0.00
## 15 Elevation.Loss 12954 1482 0 11.44 0.00
## 16 Elevation.Low 12954 1537 0 11.87 0.00
## 17 Elevation.High 12954 1537 0 11.87 0.00
## 18 Max.Grade 12954 147 0 1.13 0.00
## 19 Average.Grade 12954 0 0 0.00 0.00
## 20 Average.Positive.Grade 12954 12954 0 100.00 0.00
## 21 Average.Negative.Grade 12954 12954 0 100.00 0.00
## 22 Max.Cadence 12954 3971 0 30.65 0.00
## 23 Average.Cadence 12954 3782 0 29.20 0.00
## 24 Average.Heart.Rate 12954 2777 0 21.44 0.00
## 25 Max.Watts 12954 12954 0 100.00 0.00
## 26 Average.Watts 12954 11308 0 87.29 0.00
## 27 Calories 12954 645 0 4.98 0.00
## 28 Max.Temperature 12954 12954 0 100.00 0.00
## 29 Average.Temperature 12954 4622 0 35.68 0.00
## 30 Total.Work 12954 12398 0 95.71 0.00
## 31 Uphill.Time 12954 12954 0 100.00 0.00
## 32 Downhill.Time 12954 12954 0 100.00 0.00
## 33 Perceived.Exertion 12954 12913 0 99.68 0.00
## 34 Start.Time 12954 12954 0 100.00 0.00
## 35 Weighted.Average.Power 12954 11996 0 92.60 0.00
## 36 Power.Count 12954 11996 0 92.60 0.00
## 37 Prefer.Perceived.Exertion 12954 6522 0 50.35 0.00
## 38 Perceived.Relative.Effort 12954 12913 0 99.68 0.00
## 39 Total.Weight.Lifted 12954 12954 0 100.00 0.00
## 40 Weather.Observation.Time 12954 10395 0 80.25 0.00
## 41 Weather.Condition 12954 10395 0 80.25 0.00
## 42 Weather.Temperature 12954 10395 0 80.25 0.00
## 43 Apparent.Temperature 12954 10395 0 80.25 0.00
## 44 Dewpoint 12954 10395 0 80.25 0.00
## 45 Humidity 12954 10395 0 80.25 0.00
## 46 Weather.Pressure 12954 10395 0 80.25 0.00
## 47 Wind.Speed 12954 10395 0 80.25 0.00
## 48 Wind.Gust 12954 10395 0 80.25 0.00
## 49 Wind.Bearing 12954 10395 0 80.25 0.00
## 50 Precipitation.Intensity 12954 10395 0 80.25 0.00
## 51 Moon.Phase 12954 10395 0 80.25 0.00
## 52 Precipitation.Probability 12954 10395 0 80.25 0.00
## 53 Precipitation.Type 12954 11138 0 85.98 0.00
## 54 Cloud.Cover 12954 10395 0 80.25 0.00
## 55 Weather.Visibility 12954 10395 0 80.25 0.00
## 56 UV.Index 12954 10395 0 80.25 0.00
## 57 Weather.Ozone 12954 11929 0 92.09 0.00
## 58 Average.Elapsed.Speed 12954 1328 0 10.25 0.00
## 59 Total.Steps 12954 8524 0 65.80 0.00
## 60 Training.Load 12954 12103 0 93.43 0.00
## 61 Intensity 12954 12103 0 93.43 0.00
## 62 Average.Grade.Adjusted.Pace 12954 9858 0 76.10 0.00
## 63 Timer.Time 12954 12954 0 100.00 0.00
## 64 Recovery 12954 12541 0 96.81 0.00
## 65 Sex 12954 0 0 0.00 0.00
## 66 Activity.Date_Date 12954 0 0 0.00 0.00
## 67 Activity.Date_Time 12954 0 0 0.00 0.00Analizando la tabla generada anteriormente:
Notamos como prácticamente ninguna variable de estudio a excepción de “Activity.Gear” tiene valores vacíos, no obstante no podemos decir lo mismo para los valores NA. Deberemos de atender a un criterio de porcentaje, y segmentar o clasificar las variables entre (Buenas, medias o malas) para luego tomar las opciones pertinentes.
En primer lugar presentamos las variables con mayor porcentaje de valores NA (rango de 80% a 100%). Resultan un total de 38 columnas.
Worst_Cols_pct <- table_NA_Empty %>% filter(Pct_NA>=80 | Pct_Empty >=80) %>% select(Variable, Pct_NA,NA_count)
Worst_Cols_pct## Variable Pct_NA NA_count
## 1 Athlete.Weight 100.00 12954
## 2 Average.Positive.Grade 100.00 12954
## 3 Average.Negative.Grade 100.00 12954
## 4 Max.Watts 100.00 12954
## 5 Average.Watts 87.29 11308
## 6 Max.Temperature 100.00 12954
## 7 Total.Work 95.71 12398
## 8 Uphill.Time 100.00 12954
## 9 Downhill.Time 100.00 12954
## 10 Perceived.Exertion 99.68 12913
## 11 Start.Time 100.00 12954
## 12 Weighted.Average.Power 92.60 11996
## 13 Power.Count 92.60 11996
## 14 Perceived.Relative.Effort 99.68 12913
## 15 Total.Weight.Lifted 100.00 12954
## 16 Weather.Observation.Time 80.25 10395
## 17 Weather.Condition 80.25 10395
## 18 Weather.Temperature 80.25 10395
## 19 Apparent.Temperature 80.25 10395
## 20 Dewpoint 80.25 10395
## 21 Humidity 80.25 10395
## 22 Weather.Pressure 80.25 10395
## 23 Wind.Speed 80.25 10395
## 24 Wind.Gust 80.25 10395
## 25 Wind.Bearing 80.25 10395
## 26 Precipitation.Intensity 80.25 10395
## 27 Moon.Phase 80.25 10395
## 28 Precipitation.Probability 80.25 10395
## 29 Precipitation.Type 85.98 11138
## 30 Cloud.Cover 80.25 10395
## 31 Weather.Visibility 80.25 10395
## 32 UV.Index 80.25 10395
## 33 Weather.Ozone 92.09 11929
## 34 Training.Load 93.43 12103
## 35 Intensity 93.43 12103
## 36 Timer.Time 100.00 12954
## 37 Recovery 96.81 12541Observamos un conjunto de atributos que son propios de cada corredor, siendo la gran parte casi imposible de averiguar de manera trivial (Max.Watts,Max.Temperature,Uphill.Time,Downhill.Time,Total.Weight.Lifted,Perceived.Exertion,Perceived.Relative.Effort, Recovery,Intensity,Weighted.Average.Power,Power.Count), aún así contamos con algunos casos especiales:
-Athlete.Weight: el peso del corredor lo podríamos averiguar ya que está informado en el dataset “Profile” fusionado anteriormente, ahora bien, consideramos no hacerlo ya que ese valor no muestra/asegura realmente el peso del atleta a la hora de realizar la actividad, más bien es un valor orientativo informado por el atleta al empezar a usar strava y cuyo mantenimiento es manual.
-start.time: segun el conocimiento tras el uso del aplicativo podemos corroborar que el atributo Activity.Date corresponde a la fecha que se realizó (empezó) la actividad, encontrándose este en formato completo de fecha-hora.Presenta 100% de disponibilidad. Así pues la podemos obviar sin problema.
También contamos con algunos atributos calculables a partir de otros:
-Average.Positive.Grade, Average.Negative.Grade: Para estas dos hace falta el desnivel positivo y negativo acumulado junto con la distancia en ascenso y descenso. Al no tener disponible la segunda no podemos tratar de calcularlo.
-Total.Work : Podemos calcularla en base a la potencia generada, pero también la desconocemos.
-Training.Load : Puede resultar de la duración multiplicada por la intensidad relativa, pero desconocemos la segunda.
Por último contamos con una serie de variables relacionadas con el tiempo meterológico que acumulan cerca del 100% de valores NA. Podríamos tratar de recuperarlo en caso de disponer la ubicación donde se registra la actividad junto a la fecha y hora de la misma haciendo uso de otro dataset que nos proporcione información meterológica. No disponemos de la primera variable mencionada por lo que tendremos que ignorar los atributos, pues no nos aportan nada de esta manera.
Activities_final_cleaned_WC <- Activities_final_reduced[, -which(colMeans(is.na(Activities_final_reduced)) > 0.80)]Si bien el alto porcentaje de NA localizados en este rango de variables reduce las operaciones a realizar para poder recuperarlas, también nos hemos encontrado con impedimentos a la hora de tratar de calcularlas por no disponer tampoco de otras relacionadas. Por su parte también hemos podido recuperar otras que ya se informaban en otras variables relacionadas.El resultado final ha sido excluirlas del estudio.
Marcamos un rango en [40% - 80%] columnas con un porcentaje medio o moderado de valores NA. 3 columnas
Medium_Cols_pct <- table_NA_Empty %>% filter((Pct_NA>=40 & Pct_NA<80 )) %>% select(Variable, Pct_NA,NA_count)
Medium_Cols_pct## Variable Pct_NA NA_count
## 1 Prefer.Perceived.Exertion 50.35 6522
## 2 Total.Steps 65.80 8524
## 3 Average.Grade.Adjusted.Pace 76.10 9858Dentro de este rango sólamente tenemos 3 variables, las citamos por orden de mayor a menor porcentaje de perdidos:
-Average.Grade.Adjusted.Pace: Resulta bastante complejo de calcular ya que hace uso de la pendiente observada en cada uno de los puntos de la ruta por donde se ha registrado la actividad. Buscando la alternativa de completado, dado el caso, tampoco vale la pena completarla con un valor global o a partir de una mediana general debido a su alto porcentaje de NA. Se trata de una variable rica en cuanto a información, pero en este caso, más bien añade ruido. La excluiremos.
Total.Steps: La falta de información en este campo obedece a que este indicador es útil o se informa solamente en actividades de tipo “senderismo”,asimismo conforme se registra una actividad de tipo “carrera”, ya entran en juego otras métricas asociadas más apropiadas. Ya que vamos a basar el estudio principalmente en carreras, no vemos necesaria calcularla y la podremos excluir.
Prefer.Perceived.Exertion: se trata de una variable con tipología booleana, la cual se encarga de indicar si el corredor ha querido utilizar todo el esfuerzo que realmente podía dar. Tiene relación directa con “Perceived Exertion” y esta la hemos incluido dentro del grupo de peores columnas. Un posible motivo por el que tenemos una gran parte de NA es a que este valor no se informa directamente desde la versión del aplicativo móvil,más bien web y los corredores implicados hacen uso del dispositivo móvil buscando la comodidad. Se ha tratado de buscar información sobre la heurística asociada al cáculo, pero sin éxito. No se trata de un valor que fácilmente pueda extrapolarse o completar con el conjunto de los otros. Valoramos la opción de dejarlo en el estudio de momento dado su moderado y no excesivo número de NA.
Activities_final_cleaned_MC <- Activities_final_cleaned_WC[, -which(colMeans(is.na(Activities_final_cleaned_WC)) > 0.40 & colMeans(is.na(Activities_final_cleaned_WC))<0.80 & names(Activities_final_cleaned_WC) != "Prefer.Perceived.Exertion")]Por último definimos entre [0%-40%] aquellas columnas óptimas para su estudio y análisis. 27 columnas
Best_Cols_pct <- table_NA_Empty %>% filter((Pct_NA>=0 & Pct_NA<40 )) %>% select(Variable, Pct_NA,NA_count)
Best_Cols_pct## Variable Pct_NA NA_count
## 1 Athlete.ID 0.00 0
## 2 Activity.ID 0.00 0
## 3 Activity.Date 0.00 0
## 4 Activity.Type 0.00 0
## 5 Elapsed.Time 0.00 0
## 6 Distance 0.00 0
## 7 Max.Heart.Rate 21.45 2778
## 8 Relative.Effort 21.45 2778
## 9 Activity.Gear 29.73 3851
## 10 Moving.Time 0.00 0
## 11 Max.Speed 1.26 163
## 12 Average.Speed 0.00 0
## 13 Elevation.Gain 0.90 116
## 14 Elevation.Loss 11.44 1482
## 15 Elevation.Low 11.87 1537
## 16 Elevation.High 11.87 1537
## 17 Max.Grade 1.13 147
## 18 Average.Grade 0.00 0
## 19 Max.Cadence 30.65 3971
## 20 Average.Cadence 29.20 3782
## 21 Average.Heart.Rate 21.44 2777
## 22 Calories 4.98 645
## 23 Average.Temperature 35.68 4622
## 24 Average.Elapsed.Speed 10.25 1328
## 25 Sex 0.00 0
## 26 Activity.Date_Date 0.00 0
## 27 Activity.Date_Time 0.00 0En este grupo deberíamos tener a las mejores variables, digo debería puesto que aún no hemos analizado el valor de las variables en sí. De entre el conjunto de 27 variables, 15 presentan algún tipo de valor faltante aunque con un porcentaje bastante bajo. Analizemos los casos particularmente de mayor a menor porcentaje de perdidos:
-Variables Elevation.Gain,Max.Grade,Max.Speed,Average.Elapsed.Speed,Elevation.Loss,Elevation.Low,Elevation.High : Una variable que nos puede ayudar a completarlas es la distancia, si esta vale 0 no puede haberse hecho nada de desnivel ni tampoco ir a ninguna velocidad. Una vez hecho esto, analizamos el tipo de las actividades con desnivel positivo faltante para así determinar si se trata de alguna actividad indoor y poder descartar que pueda intervenir la variable.
Activities_final_cleaned_BC <- Activities_final_cleaned_MCActivities_final_cleaned_MC %>% filter(is.na(Elevation.Gain)& Distance==0)%>% count() %>% print()## n
## 1 95Activities_final_cleaned_BC$Elevation.Gain[ Activities_final_cleaned_BC$Distance == 0 &is.na(Activities_final_cleaned_BC$Elevation.Gain) ] <- 0Para Elevation.Gain del total de 116 valores perdidos, 95 tenemos la certeza de que toman valor 0 ya que su distancia para la actividad es 0.
Activities_final_cleaned_MC %>% filter(is.na(Max.Grade)& Distance==0)%>% count() %>% print()## n
## 1 114Activities_final_cleaned_BC$Max.Grade[ Activities_final_cleaned_BC$Distance == 0 &is.na(Activities_final_cleaned_BC$Max.Grade) ] <- 0Para Max.Grade de los 147 valores vacíos, 114 se encuentran con la condición de distancia 0.
Activities_final_cleaned_MC %>% filter(is.na(Max.Speed)& Distance==0)%>% count() %>% print()## n
## 1 130Activities_final_cleaned_BC$Max.Speed[ Activities_final_cleaned_BC$Distance == 0 &is.na(Activities_final_cleaned_BC$Max.Speed) ] <- 0Para Max.Speed encontramos bajo esta condición 130 de 163.
Activities_final_cleaned_MC %>% filter(is.na(Average.Elapsed.Speed)& Distance==0)%>% count()%>% print()## n
## 1 399Activities_final_cleaned_BC$Average.Elapsed.Speed[ Activities_final_cleaned_BC$Distance == 0 &is.na(Activities_final_cleaned_BC$Average.Elapsed.Speed) ] <- 0Para Average.Elapsed.Speed 399 de 1471.
Activities_final_cleaned_MC %>% filter(is.na(Elevation.Loss)& Distance==0)%>% count() %>% print()## n
## 1 1415Activities_final_cleaned_BC$Elevation.Loss[ Activities_final_cleaned_BC$Distance == 0 &is.na(Activities_final_cleaned_BC$Elevation.Loss) ] <- 0Para Elevation.Loss 1415 de 1507.
Activities_final_cleaned_MC %>% filter(is.na(Elevation.Low)& Distance==0)%>% count() %>% print()## n
## 1 1470Activities_final_cleaned_BC$Elevation.Low[ Activities_final_cleaned_BC$Distance == 0 &is.na(Activities_final_cleaned_BC$Elevation.Low) ] <- 0Para Elevation.Low 1470 de 1567.
Activities_final_cleaned_MC %>% filter(is.na(Elevation.High)& Distance==0)%>% count() %>% print()## n
## 1 1470Activities_final_cleaned_BC$Elevation.High[ Activities_final_cleaned_BC$Distance == 0 &is.na(Activities_final_cleaned_BC$Elevation.High) ] <- 0Para Elevation.High 1470 de 1567.
Para todos estos casos podemos asumir un valor 0.
Para el resto analizamos el tipo de las actividades:
Activities_final_cleaned_MC %>% filter(is.na(Elevation.Gain)& Distance!=0) %>% group_by(Activity.Type) %>%select(Activity.Type) %>% count() %>% print()## # A tibble: 5 × 2
## # Groups: Activity.Type [5]
## Activity.Type n
## <chr> <int>
## 1 Elliptical 1
## 2 Hike 3
## 3 Ride 7
## 4 Run 9
## 5 Virtual Ride 1Activities_final_cleaned_MC %>% filter(is.na(Max.Grade)& Distance!=0) %>% group_by(Activity.Type) %>%select(Activity.Type) %>% count() %>% print()## # A tibble: 5 × 2
## # Groups: Activity.Type [5]
## Activity.Type n
## <chr> <int>
## 1 Elliptical 1
## 2 Hike 3
## 3 Ride 7
## 4 Run 21
## 5 Virtual Ride 1Activities_final_cleaned_MC %>% filter(is.na(Max.Speed)& Distance!=0) %>% group_by(Activity.Type) %>%select(Activity.Type) %>% count() %>% print()## # A tibble: 5 × 2
## # Groups: Activity.Type [5]
## Activity.Type n
## <chr> <int>
## 1 Elliptical 1
## 2 Hike 3
## 3 Ride 7
## 4 Run 21
## 5 Virtual Ride 1Activities_final_cleaned_MC %>% filter(is.na(Average.Elapsed.Speed)& Distance!=0) %>% group_by(Activity.Type) %>%select(Activity.Type) %>% count() %>% print()## # A tibble: 5 × 2
## # Groups: Activity.Type [5]
## Activity.Type n
## <chr> <int>
## 1 Hike 41
## 2 Ride 142
## 3 Run 705
## 4 Walk 10
## 5 Workout 31Activities_final_cleaned_MC %>% filter(is.na(Elevation.Loss)& Distance!=0) %>% group_by(Activity.Type) %>%select(Activity.Type) %>% count() %>% print()## # A tibble: 6 × 2
## # Groups: Activity.Type [6]
## Activity.Type n
## <chr> <int>
## 1 Elliptical 1
## 2 Hike 3
## 3 Ride 7
## 4 Run 54
## 5 Virtual Ride 1
## 6 Weight Training 1Activities_final_cleaned_MC %>% filter(is.na(Elevation.Low)& Distance!=0) %>% group_by(Activity.Type) %>%select(Activity.Type) %>% count() %>% print()## # A tibble: 6 × 2
## # Groups: Activity.Type [6]
## Activity.Type n
## <chr> <int>
## 1 Elliptical 1
## 2 Hike 3
## 3 Ride 7
## 4 Run 54
## 5 Virtual Ride 1
## 6 Weight Training 1Activities_final_cleaned_MC %>% filter(is.na(Elevation.High)& Distance!=0) %>% group_by(Activity.Type) %>%select(Activity.Type) %>% count() %>% print()## # A tibble: 6 × 2
## # Groups: Activity.Type [6]
## Activity.Type n
## <chr> <int>
## 1 Elliptical 1
## 2 Hike 3
## 3 Ride 7
## 4 Run 54
## 5 Virtual Ride 1
## 6 Weight Training 1-Virtual Ride,Elliptical : son actividades indoor por lo que podemos asumir un valor 0 para las variables Elevation.Gain,Max.Grade,Elevation.Loss,Elevation.Low,Elevation.High
columnas_exclusion2 <- c("Elevation.Gain", "Max.Grade","Elevation.Loss","Elevation.Low","Elevation.High")
Acticity_Type <- c("Virtual Ride","Elliptical")
for (col in columnas_exclusion2) {
Activities_final_cleaned_BC[Activities_final_cleaned_BC$Distance != 0 & Activities_final_cleaned_BC$Activity.Type %in% Acticity_Type, col] <- 0
}-Hike,Ride: son actividades outdoor pero perfectamente se pueden tratar de actividades hechas en asfalto sin nada de montaña de por medio.Podremos asumir el valor 0 para las 2 primeras variables relacionadas con la altitud .
columnas_exclusion2 <- c("Elevation.Gain", "Max.Grade")
Acticity_Type <- c("Hike","Ride")
for (col in columnas_exclusion2) {
Activities_final_cleaned_BC[Activities_final_cleaned_BC$Distance != 0 & is.na(Activities_final_cleaned_BC[[col]]) & Activities_final_cleaned_BC$Activity.Type %in% Acticity_Type, col] <- 0
}-Run: tras revisarlas y dado el conocimiento del dataset, concluimos que se tratan de actividades que como hemos comentado en el punto anterior, son carreras realizadas en asfalto sin desnivel de por medio. Asumimos pues valor 0 para las variables Elevation.Gain,Max.Grade,Elevation.Loss,Elevation.Low,Elevation.High.
columnas_exclusion2 <- c("Elevation.Gain", "Max.Grade","Elevation.Loss","Elevation.Low","Elevation.High")
Acticity_Type <- c("Run")
for (col in columnas_exclusion2) {
Activities_final_cleaned_BC[Activities_final_cleaned_BC$Distance != 0 & is.na(Activities_final_cleaned_BC[[col]]) & Activities_final_cleaned_BC$Activity.Type %in% Acticity_Type, col] <- 0
}Para la tercera y cuarta variable no tiene mucho sentido que se haya recorrido una distancia sin velocidad máxima realizada, deberemos de asumir como valor la variable average speed, pues se acerca más a la realidad. Tras analizar la variable average speed a la hora de proceder a la sustitución, podemos deducir un posible motivo por el que no se haya informado la variable: en estas actividades se ha alcanzado una velocidad media muy baja (entorno a 1 o 3 kilómetros por hora).
columnas_exclusion2 <- c("Max.Speed", "Average.Elapsed.Speed")
for (col in columnas_exclusion2) {
Activities_final_cleaned_BC[Activities_final_cleaned_BC$Distance != 0 & is.na(Activities_final_cleaned_BC[[col]]), col] <- 0
}Para calories,se ha averiguado que se puede calcular mediante la potencia y un coeficiente de eficiencia humana. Este primero lo tenemos en muchas observaciones pero el segundo no hemos conseguido averiguar su origen. También hemos leído documentación sobre otras formas de cálculo, pero aplicándolo sobre ejemplos donde ya existía la variable calculada, estos no se ajustan a la realidad. Hablamos de una variable con sólo un 5% de valores faltantes respecto al total, es una porción muy pequeña, por lo que decidimos completarla con el cálculo de la mediana atendiendo al usuario y tipo de actividad implicado.
Activities_final_cleaned_BC <- Activities_final_cleaned_BC %>%
group_by(Athlete.ID, Activity.Type) %>%
mutate(Calories = ifelse(
is.na(Calories),
mean(Calories, na.rm = TRUE),
Calories
)) %>%
ungroup() %>%
#Cubrimos el caso en que para un atleta y tipo de actividad determinado no existan valores.Atendemos sólamente al atleta.
group_by(Athlete.ID) %>%
mutate(Calories = ifelse(
is.na(Calories),
mean(Calories, na.rm = TRUE),
Calories
)) %>%
ungroup()Centrándonos en el resto de variables con valores faltantes, debemos de tener en cuenta que pueden deberse al registro de la actividad sin un dispositivo equipado con un monitor de ritmo cardiaco. Este, para poder predecirlo, no sólamente se necesita del atleta /actividad en cuestión puesto que la frecuencia cardíaca no es estable dentro de estos dos condicionantes (atleta y actividad), también necesitamos de alguna otra variable como el esfuerzo relativo. Encontramos que esta última también se encuentra vacía para esos mismos valores vacíos optamos por dejarlas así, pues contamos con el 80% de sus datos informados.
-Variable Activity.Gear: hablamos de una variable sin mucha repercusión para el caso de estudio actual y con un poco menos del 30% de NA. Optamos por completarla con una constante global como puede ser “Desconocido”
Activities_final_cleaned_BC$Activity.Gear[is.na(Activities_final_cleaned_BC$Activity.Gear) | Activities_final_cleaned_BC$Activity.Gear ==""] <- "Unknown"###Variables redundantes
Durante la primera fase de la recolección y análisis tuvimos que separar la variable fecha en dos distintas: fecha por una parte (Activity.Date_Date) y tiempo por otra (Activity.Date_Time). Con ello, la variable inicial (Activity.Date) no nos aportará nada, la excluimos.
Activities_final_cleaned_BC <- Activities_final_cleaned_BC[, !(names(Activities_final_cleaned_BC) == "Activity.Date")]Activities_final_Transformed<- Activities_final_cleaned_BC-Crear variable nueva que enmascare el tipo de actividad (indoor o outdoor)
Tras una revisión de las horas registradas en las actividades, notamos una diferencia horaria, contemplando 2 horas menos de lo que realmente fué, o 1 hora en caso de que el cambio horario ya hubiera sucedido. Con ello, para adecuarnos a la mayor realidad posible tendremos que sumar dos a todas las horas con excepción de sumar una si fecha supera el >26/10 (dia y mes del cambio horario de invierno).
Activities_final_Transformed$Activity.Date_Time <-
format(
as.POSIXct(paste(Activities_final_Transformed$Activity.Date_Date, Activities_final_Transformed$Activity.Date_Time), tz = "UTC") + ifelse(Activities_final_Transformed$Activity.Date_Date > as.Date("2025-10-26"),
3600, # +1 hora
7200) # +2 horas
, "%H:%M:%S")Creación de columna para la estación del año basándonos en el mes de la fecha correspondiente.
Activities_final_Transformed <- Activities_final_Transformed %>%
mutate(Season = case_when(
month(Activity.Date_Date) %in% c(12, 1, 2) ~ "Winter",
month(Activity.Date_Date) %in% c(3, 4, 5) ~ "Spring",
month(Activity.Date_Date) %in% c(6, 7, 8) ~ "Summer",
month(Activity.Date_Date) %in% c(9, 10, 11) ~ "Autumn"
))
Activities_final_Transformed$Season <- factor(Activities_final_Transformed$Season,
levels = c("Spring","Summer","Autumn","Winter"))Creación de una columna que nos puede ser de mucha utilidad a la hora de realizar el estudio posterior, hablamos del ritmo medio o pace.
Activities_final_Transformed <- Activities_final_Transformed %>%
mutate(Pace = ifelse(between(as.numeric(Distance),0,1) | is.na(as.numeric(Distance)),
0,
(as.numeric(Moving.Time) / 60) / as.numeric(Distance)))Activities_final_Transformed$Indoor.Outdoor <-
ifelse(Activities_final_Transformed$Activity.Type %in% c("WeightTraining", "Elliptical", "VirtualRide"),
"Indoor",
ifelse(Activities_final_Transformed$Activity.Type == "Workout" & Activities_final_Transformed$Distance == 0,
"Indoor"
, "Outdoor"
)
)Deberemos de analizar el dataset global partiendo de las variables que más lo prepresenten. Se propone emplear la variable Activity.Type y analizarla junto a variables como la distancia a fin de descartar en una fase temprana actividades anómalas.
Activities_final_ExtremeValues<- Activities_final_TransformedActivities_final_ExtremeValues <- Activities_final_ExtremeValues[!(Activities_final_ExtremeValues$Activity.Type=="Run" & between(Activities_final_ExtremeValues$Distance,0,1) ) , ] Se consideran como anómalas aquellas actividades donde la actividad es correr pero no de recorre ninguna distancia, pues no tiene sentido alguno y si no las excluimos su única función será contaminar o perjudicar la muestra global. Afortunadamente se trata de algo puntual y que ha sucedido pocas veces (134/12821), lo cual puede obedecer a confusiones o anomalías a la hora de empezar a realizar la actividad y tener que pararlas.
Procedemos con un análisis boxplot de los valores de las variables numéricas implicadas.
cols_exclusion <- c("Athlete.ID", "Activity.ID", "Elapsed.Time") #Exlucimos variables identificadoras o que tengan una escala muy elavada con respecto al resto.
#Generamos tabla visual.
outliers <- Activities_final_ExtremeValues %>%
select(where(is.numeric), -all_of(cols_exclusion)) %>%
summarise(across(everything(), ~ {
q1 <- quantile(.x, 0.25, na.rm = TRUE)
q3 <- quantile(.x, 0.75, na.rm = TRUE)
iqr <- q3 - q1
sum(.x < (q1 - 1.5 * iqr) | .x > (q3 + 1.5 * iqr), na.rm = TRUE)
})) %>%
pivot_longer(everything(),
names_to = "variable",
values_to = "num_outliers") %>%
arrange(desc(num_outliers))
print(outliers)## # A tibble: 20 × 2
## variable num_outliers
## <chr> <int>
## 1 Average.Grade 3824
## 2 Elevation.Low 2316
## 3 Distance 753
## 4 Moving.Time 658
## 5 Relative.Effort 588
## 6 Elevation.Gain 547
## 7 Elevation.Loss 547
## 8 Calories 350
## 9 Elevation.High 336
## 10 Max.Speed 139
## 11 Average.Cadence 107
## 12 Average.Elapsed.Speed 88
## 13 Average.Speed 84
## 14 Pace 68
## 15 Max.Cadence 33
## 16 Average.Heart.Rate 15
## 17 Max.Heart.Rate 14
## 18 Average.Temperature 9
## 19 Prefer.Perceived.Exertion 5
## 20 Max.Grade 0# Generamos boxplot visual para las variables con valores extremos.
vars_with_outliers <- c(
"Average.Grade", "Elevation.Low", "Moving.Time", "Relative.Effort",
"Elevation.Loss", "Elevation.Gain", "Calories", "Elevation.High",
"Max.Speed", "Average.Cadence", "Average.Speed", "Average.Elapsed.Speed",
"Max.Cadence", "Average.Heart.Rate", "Max.Heart.Rate",
"Average.Temperature", "Prefer.Perceived.Exertion"
)
# Filtramos las variables anteriores sobre el conjunto general.
Activities_final_ExtremeValues_outliers <- Activities_final_ExtremeValues %>% select(all_of(vars_with_outliers))
# Generamos gráfico general uno a uno para pder analizarlos mejor.
for (v in vars_with_outliers) {
p <- Activities_final_ExtremeValues_outliers %>%
pivot_longer(everything(), names_to = "var", values_to = "value") %>%
filter(var == v) %>%
ggplot(aes(x = var, y = value)) +
geom_boxplot(outlier.size = 2, outlier.alpha = 0.7) +
theme_minimal(base_size = 16) +
labs(
title = paste("Boxplot de", v),
x = "",
y = "Valor"
) +
coord_flip()
print(p)
}
## Warning: Removed 11 rows containing non-finite outside the scale range
## (`stat_boxplot()`).
## Warning: Removed 2640 rows containing non-finite outside the scale range
## (`stat_boxplot()`).
## Warning: Removed 11 rows containing non-finite outside the scale range
## (`stat_boxplot()`).
## Warning: Removed 11 rows containing non-finite outside the scale range
## (`stat_boxplot()`).
## Warning: Removed 3678 rows containing non-finite outside the scale range
## (`stat_boxplot()`).
## Warning: Removed 3867 rows containing non-finite outside the scale range
## (`stat_boxplot()`).
## Warning: Removed 2639 rows containing non-finite outside the scale range
## (`stat_boxplot()`).
## Warning: Removed 2640 rows containing non-finite outside the scale range
## (`stat_boxplot()`).
## Warning: Removed 4465 rows containing non-finite outside the scale range
## (`stat_boxplot()`).
## Warning: Removed 6365 rows containing non-finite outside the scale range
## (`stat_boxplot()`).
Analizamos los outliers a fin de verificar si són reales y poder tomar una decisión al respecto.
VALORES ELEVADOS DETECTADOS
-Average.Grade: Podemos ver como la gran mayoria de valores convergen en 0 aunque se trata de una variable muy diversa. Tras analizar visualmente esos valores extremos confirmamos que pueden ser correctos, tengo constancia de que algunos atletas hayan hecho retos de kilómetros verticales que destacan por la elevada pendiente.
-Elevation.Low: en este caso vamos a aplicar varias capas basándonos en información sobre otras variables relacionadas o bien concimientos sobre ella:
-En caso de que Elevation.High coincida con Elevation.Low , Elevation.Gain debe de ser aproximadamente cero.
Activities_final_ExtremeValues %>%
filter(Elevation.High==Elevation.Low & Elevation.Gain != 0) %>%
select(Activity.Date_Date,Activity.Type,Elevation.Low,Elevation.High,Elevation.Gain,Athlete.ID) %>%
print()## # A tibble: 7 × 6
## Activity.Date_Date Activity.Type Elevation.Low Elevation.High Elevation.Gain
## <date> <chr> <dbl> <dbl> <dbl>
## 1 2025-01-23 Run -500 -500 369
## 2 2025-01-27 Hike -500 -500 180
## 3 2025-01-28 Hike -500 -500 462
## 4 2025-01-30 Run -500 -500 377
## 5 2025-02-13 Run -500 -500 447
## 6 2024-06-26 Run 0 0 850
## 7 2024-07-20 Run 0 0 3600
## # ℹ 1 more variable: Athlete.ID <dbl>Tal y como podemos observar estas 7 actividades aunque la variable Elevation.Gain parece correcta (dentro de los valores normales), no lo es Elevation.Low ni Elevation.Hight. Deberemos de excluirlas.
Activities_final_ExtremeValues <- Activities_final_ExtremeValues[!(Activities_final_ExtremeValues$Elevation.High==Activities_final_ExtremeValues$Elevation.Low & Activities_final_ExtremeValues$Elevation.Gain!=0), ]-En caso de que Elevation.High y Elevation.Low no coincidan pero Elevation.Gain tenga valor 0.
Activities_final_ExtremeValues %>%
filter(Elevation.High!=Elevation.Low & Elevation.Gain == 0) %>%
select(Activity.Date_Date,Activity.Type,Elevation.Low,Elevation.High,Elevation.Gain,Distance,Athlete.ID) %>%
print()## # A tibble: 316 × 7
## Activity.Date_Date Activity.Type Elevation.Low Elevation.High Elevation.Gain
## <date> <chr> <dbl> <dbl> <dbl>
## 1 2022-06-10 Run 4.4 8.2 0
## 2 2024-05-26 Run 651. 881 0
## 3 2021-07-07 Run 3 6 0
## 4 2021-07-13 Run -30 -27 0
## 5 2021-08-23 Run 2 6 0
## 6 2021-10-05 Run 28 33 0
## 7 2021-11-17 Run -39 -34 0
## 8 2021-11-19 Run 24 40 0
## 9 2021-11-24 Run 34 36 0
## 10 2021-12-19 Run 32 35 0
## # ℹ 306 more rows
## # ℹ 2 more variables: Distance <dbl>, Athlete.ID <dbl>Esta condición bajo el caso de actividades outdoor se puede dar perfectamente, pues podemos inidicar la actividad en la cima de una montaña , terminarla abajo del todo sin ganar nada de elevación. Será una opción segura dejar a 0 Elevation.High y Elevation.Low , siempre y cuando se trate de actividades indoor como gimnasio.
Selected_Activities <- c("Workout","Weight Training")
cond <- Activities_final_ExtremeValues$Activity.Type %in% Selected_Activities &
Activities_final_ExtremeValues$Elevation.Gain == 0 &
Activities_final_ExtremeValues$Elevation.High != Activities_final_ExtremeValues$Elevation.Low
Activities_final_ExtremeValues$Elevation.High[cond] <- 0
Activities_final_ExtremeValues$Elevation.Low[cond] <- 0-Con lo que respecta a los valores extremos inferiores, notamos que no son reales, pues las actividades corresponden a personas que han desarrollado sus actividades por la misma zona aproximadamente (área de valencia) donde la elevación mínima sobre el nivel del mar no baja de los 0 metros. Para este caso,hemos localizado algunas actividades propias y tras analizarlas en el aplicativo podemos detectar una pequeña anomalía puntual con el cálculo de desnivel. Así pues, optamos por corregir los valores con un valor medio estándar para la comunidad valenciana.
Activities_final_ExtremeValues$Elevation.Low[Activities_final_ExtremeValues$Elevation.Low < 0] <-10-Con lo que respecta a los valores extremos superiores, revisando y contrastando la veracidad de los puntos más extremos confirmamos que son veridicos, pues varios de los atletas implicados han realizado desfios en zonas de alta envergadura montañosa, incluyendo países como Nepal.
En este caso podemos encontrar valores bastante extremos donde se descarta una posible hazaña relacionada con el mundo del deporte. Estos valores parecen provenir de errores de altitud propios de GPS.
-Relative.Effort,Elevation.Gain,Calories,Elevation.High: En línea con lo que se ha comentado en la variable anterior, podemos corroborar como veridicas los valores extremos encontrados.
VALORES MEDIOS DETECTADOS.
-Max.Speed,Average.Cadence,Average.Speed,Average.Elapsed.Speed : Vemos como los valores extremos para la variable Average.Speed parecen correctos ya que pertencen a actividades de bicicleta, pues aquí la velocidad que se suele alcanzar son más elevadas. Por su parte, no podemos decir lo mismo para la variable Max.Speed donde sí que encontramos valores bastante imposibles para actividades de carrera, si bien hablamos de un pico de velocidad superior a lo habitual, no es posible que se llegue a los 34 km/h en atletas no profesionales como es el caso.
Activities_final_ExtremeValues %>%
filter(Activity.Type == "Run" & as.numeric( Max.Speed )>18 ) %>%
print()## # A tibble: 11 × 30
## Athlete.ID Activity.ID Activity.Type Elapsed.Time Distance Max.Heart.Rate
## <dbl> <dbl> <chr> <int> <dbl> <dbl>
## 1 12005698 8701484892 Run 14188 30.2 179
## 2 12005698 9170913382 Run 11532 24 187
## 3 39779781 4652901850 Run 1589 13.2 NA
## 4 39779781 8550577092 Run 2181 14.5 NA
## 5 39779781 9287499776 Run 4373 16.2 NA
## 6 57717801 12693405843 Run 18557 40.2 185
## 7 63055946 4819139568 Run 7995 3.84 NA
## 8 36944607 4734241635 Run 5045 9.02 161
## 9 85112912 6787949982 Run 3867 12.2 NA
## 10 85112912 12959169290 Run 3397 8.03 NA
## 11 85112912 14696689130 Run 8855 14.3 NA
## # ℹ 24 more variables: Relative.Effort <int>, Activity.Gear <chr>,
## # Moving.Time <dbl>, Max.Speed <dbl>, Average.Speed <dbl>,
## # Elevation.Gain <dbl>, Elevation.Loss <dbl>, Elevation.Low <dbl>,
## # Elevation.High <dbl>, Max.Grade <dbl>, Average.Grade <dbl>,
## # Max.Cadence <dbl>, Average.Cadence <dbl>, Average.Heart.Rate <dbl>,
## # Calories <dbl>, Average.Temperature <dbl>, Prefer.Perceived.Exertion <dbl>,
## # Average.Elapsed.Speed <dbl>, Sex <chr>, Activity.Date_Date <date>, …Reasignamos los valores implicadaos basándonos en una median razonable factible.
cond <-Activities_final_ExtremeValues$Activity.Type == "Run" &
as.numeric(Activities_final_ExtremeValues$Max.Speed) >18
Activities_final_ExtremeValues$Max.Speed[cond] <- 16VALORES BAJOS DETECTADOS
A priori estos no afectan de manera significativa al conjunto global de datos, indistintamente, podemos fijarnos en los valores extremos de la variable Max.Heart.Rate donde notamos algunos valores puntuales elevados que no tienen sentido, se trata de actividades con pico máximos cardíacos desorbitados con distancia baja o muy baja y velocidad máxima baja o muy baja.
Activities_final_ExtremeValues %>%
filter(Max.Heart.Rate >200 & Distance == 0 & Max.Speed ==0) %>%
print()## # A tibble: 8 × 30
## Athlete.ID Activity.ID Activity.Type Elapsed.Time Distance Max.Heart.Rate
## <dbl> <dbl> <chr> <int> <dbl> <dbl>
## 1 63055946 14417492873 Ride 2435 0 220
## 2 63055946 14602591226 Ride 2586 0 221
## 3 63055946 14623177073 Ride 2777 0 210
## 4 63055946 14674831400 Ride 3200 0 211
## 5 63055946 14768372005 Ride 2843 0 227
## 6 63055946 15524883371 Ride 2410 0 206
## 7 21939621 5033378565 Weight Training 2403 0 214
## 8 21939621 7771687564 Ride 423 0 229
## # ℹ 24 more variables: Relative.Effort <int>, Activity.Gear <chr>,
## # Moving.Time <dbl>, Max.Speed <dbl>, Average.Speed <dbl>,
## # Elevation.Gain <dbl>, Elevation.Loss <dbl>, Elevation.Low <dbl>,
## # Elevation.High <dbl>, Max.Grade <dbl>, Average.Grade <dbl>,
## # Max.Cadence <dbl>, Average.Cadence <dbl>, Average.Heart.Rate <dbl>,
## # Calories <dbl>, Average.Temperature <dbl>, Prefer.Perceived.Exertion <dbl>,
## # Average.Elapsed.Speed <dbl>, Sex <chr>, Activity.Date_Date <date>, …Dadas estas actividades, optamos por excluirlas ya que no suponen un volumen significativo respecto al total.
cond <- with(Activities_final_ExtremeValues,
Max.Heart.Rate > 200 &
Distance == 0 &
Max.Speed == 0)
# Reemplazamos NA por FALSE explícitamente para evitar problemas con el valor NA que pueda tener algún campo usado.
cond[is.na(cond)] <- FALSE
Activities_final_ExtremeValues <- Activities_final_ExtremeValues[!cond, ]Después de una dedicada fase de prepación de los datos de los 11 corredores, damos paso al análisis definitorio de las variables que han resultado así como el número de observaciones de las mismas. Así pues,tomando como base 12830 actividades recolectadas al inicio, han resultado 12506, como podemos observar no hemos tenido que segregar una cantidad significativa de observaciones anómalas, de hecho muchas de ellas las hemos podido corregir gracias al conocimiento del datatset y al mundo de las carreras. Por su parte,partiendo de cerca de 100 dimensiones o columnas iniciales, nos hemos quedado con 28, las cuales resultan de un estudio minucioso de sus valores.
Con el presente análisis que vamos a practicar, se busca tratar de responder a parte de las preguntas planteadas al inicio del trabajo así como entender con más grado de detalle la estructuración de los mismos:
Activities_final_Analysis <- Activities_final_ExtremeValues
write.csv(Activities_final_Analysis, "Activities_final_Analysis.csv", row.names = FALSE)# Calculamos matriz de correlaciones entre algunas variables cuantitativas de interés
numeric_vars <- Activities_final_Analysis %>%
select(Distance,Moving.Time, Average.Speed, Average.Heart.Rate, Max.Heart.Rate, Relative.Effort, Calories, Average.Temperature,Elevation.Gain) %>%
select_if(is.numeric) %>%
drop_na()
corr_matrix <- cor(na.omit(numeric_vars))
#Visualizamos.
corrplot(corr_matrix, method = "color", type = "upper", tl.cex = 0.7, addCoef.col = "black")
Relaciones fuertes - Calories con Relative.Effort (0.77): da a entender que un mayor esfuerzo implica más gasto energético. -Distance con Calories (0.75) y Moving.Time (0.75): estas dos son bastante lógicas, a cuanta más distancia recorras indispensablemente vas a tener que quemar más calorias para poder mover el cuerpo. -Relative.Effort con Elevation.Gain (0.67): subir implica más esfuerzo, aunque distancia sea igual.
Relaciones moderadas -Distance con Average.Speed (0.53): es esperable, aunque no lineal en todos los casos. -Average.Heart.Rate con Relative.Effort (0.56): consistente con la idea de usar la FC como estimador del esfuerzo.
Correlaciones débiles o negativas -Average.Temperature se correlaciona débilmente con las demás, lo que es interesante y podrá ser objeto de análisis.
Damos comienzo con la implementación de una serie de gráficos encargados de dar una visión general y más completa de los datos que nos disponemos a analizar. Haremos uso de variables claves como distancia, ritmo, desnivel, frecuencia cardíaca, esfuerzo relativo…
# Agrupamiento K-means por Rendimiento de Atletas
#Para cada atleta calculamos distancia media,ritmo medio y elevación media en sus actividades.
athlete_summary <- Activities_final_Analysis %>%
#filter(Activity.Type == "Run") %>%
group_by(Athlete.ID) %>%
summarise(
Distancia_media_km = mean(Distance, na.rm = TRUE),
Ritmo_medio = mean(Pace, na.rm = TRUE), # en min/km
Elevacion_media = mean(Elevation.Gain, na.rm = TRUE)
)
athlete_features <- athlete_summary %>%
select(Distancia_media_km, Ritmo_medio, Elevacion_media) %>%
scale()
set.seed(123) # fijamos semilla para reproducibilidad
modelo_km3 <- kmeans(athlete_features, centers = 3, nstart = 20)
athlete_summary$Cluster <- factor(modelo_km3$cluster)
print(athlete_summary)## # A tibble: 11 × 5
## Athlete.ID Distancia_media_km Ritmo_medio Elevacion_media Cluster
## <dbl> <dbl> <dbl> <dbl> <fct>
## 1 12005698 15.1 7.76 719. 1
## 2 21875774 5.14 3.26 63.2 3
## 3 21939621 10.7 6.96 421. 1
## 4 36944607 25.0 5.57 338. 2
## 5 39779781 19.4 4.47 106. 2
## 6 49973975 3.37 3.07 96.2 3
## 7 57717801 5.72 4.93 191. 3
## 8 63055946 4.48 3.33 113. 3
## 9 73163720 10.6 8.82 496. 1
## 10 85112912 15.5 6.90 518. 1
## 11 106331448 6.90 4.75 201. 3# Representamos distancia media vs Elevación media aplicando un filtro de grupo de atleta generado anteriormente.
ggplot(athlete_summary, aes(x = Distancia_media_km, y = Elevacion_media, color = Cluster)) +
geom_point(size = 3, alpha = 0.8) +
geom_text(aes(label = Athlete.ID), vjust = -0.8, size = 3, show.legend = FALSE) +
labs(x = "Distancia media (km)", y = "Elevación media (m)",
title = "Clusters de atletas según distancia, ritmo y elevación",
color = "Cluster") +
theme_minimal()
# Selección de variables de interés
vars <- Activities_final_Analysis %>%
select(
`Ritmo(min/km)` = Pace,
`Distancia(km)` = Distance,
`FC Media(lpm)` = Average.Heart.Rate,
`Esfuerzo Relativo(puntos)` = Relative.Effort
)
# Reestructurar el data frame a formato largo
df_long <- melt(vars)## No id variables; using all as measure variablesggplot(df_long, aes(x = value, fill = variable)) +
geom_histogram(bins = 30, color = "white", alpha = 0.85) +
facet_wrap(~variable, scales = "free", ncol = 2) +
labs(title = "Distribución de variables clave", x = "Valor", y = "Frecuencia") +
theme_minimal() +
theme(legend.position = "none")## Warning: Removed 5275 rows containing non-finite outside the scale range
## (`stat_bin()`).
Atendiendo a la representación visual expuesta, pasamos a detallar su significado:
La variable Ritmo (min/km) presenta una distribución marcadamente asimétrica hacia la derecha. La mayor concentración de valores se sitúa entre los 4 y 8 minutos por kilómetro, lo que refleja rangos típicos de ritmo de carrera en corredores aficionados o entrenados. Sin embargo, vemos una cola larga de valores superiores entorno a 12 min/km, los cuales podrían estar asociados a caminatas, pausas, entrenamientos suaves o actividades con errores de registro. Esta distribución sugiere la necesidad de considerar un filtrado de valores atípicos en los análisis posteriores centrados en rendimiento.
En cuanto a la Distancia (km), se observa una alta concentración de actividades por debajo de los 20 km, con un pico marcado entre los 5 y 10 km. La silueta representada es habitual en disciplinas de resistencia y refleja la predominancia de entrenamientos cortos o medios. Las actividades de larga distancia (>30 km) están presentes pero son minoritarias, por lo que podrían analizarse por separado.
La Frecuencia Cardíaca Media (FC Media) presenta una distribución aproximadamente normal, centrada en torno a los 140 latidos por minuto. Este patrón propone una estabilidad fisiológica entre los atletas durante sus actividades, con valores que en su mayoría oscilan entre 100 y 170 lpm. Esta variable será clave para interpretar el nivel de esfuerzo fisiológico y su evolución en función de distancia, temperatura o sexo.
Por último, la variable Esfuerzo Relativo muestra una clara asimetría positiva, mostrando una gran cantidad de actividades con puntuaciones bajas (<100), y una cola larga que llega a valores superiores a 300 puntos. Este tipo de variable acumulativa, muy influida por distancia, desnivel y tiempo de ejercicio, sugiere que puede ser más informativo trabajar con rangos, percentiles o incluso clasificaciones ordinales, en lugar de tratarla como una métrica continua homogénea.
Seguimos con una serie de comparativos y evolutivos.
# Calculamos la distancia total recorrida por semana para todos los corredores combinados.
weekly_distance <- Activities_final_Analysis %>%
mutate(Semana = floor_date(Activity.Date_Date, unit = "week")) %>%
group_by(Semana) %>%
summarise(Kilometros_semanales = sum(as.numeric(Distance), na.rm = TRUE))
#Visualización de evoluación.
ggplot(weekly_distance, aes(x = Semana, y = Kilometros_semanales)) +
geom_line(color = "steelblue", size = 1) +
geom_smooth(method = "loess", span = 0.2, se = FALSE, color = "orange") + # línea suavizada para tendencia
labs(x = "Semana", y = "Kilómetros totales", title = "Evolución semanal del kilometraje total") +
scale_x_date(date_breaks = "6 months", date_labels = "%Y-%m") + # marcas cada 6 meses
theme_minimal()## Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
## ℹ Please use `linewidth` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.## `geom_smooth()` using formula = 'y ~ x'
ggplot(Activities_final_Analysis %>% filter(!is.na(Pace)), aes(x = Sex, y = Pace, fill = Sex)) +
geom_boxplot(outlier.color = "red", outlier.alpha = 0.6) +
labs(title = "Comparación de Ritmo promedio por género",
x = "Género del atleta", y = "Ritmo (min/km)") +
theme_minimal()
mix <- Activities_final_Analysis %>%
count(Season, Activity.Type, Sex, name = "n")
plot_ly(mix, x = ~Season, y = ~n, color = ~Activity.Type, type = "bar") %>%
layout(barmode = "stack") %>%
layout(yaxis = list(title = "Nº actividades"), xaxis = list(title = "Estación"))ggplot(Activities_final_Analysis %>% filter(!is.na(Average.Temperature), !is.na(Pace),Average.Temperature>-20),
aes(x = Average.Temperature, y = Pace)) +
geom_point(alpha = 0.4, color = "steelblue") +
geom_smooth(method = "loess", color = "red") +
labs(title = "Influencia de la Temperatura en el Ritmo",
x = "Temperatura promedio (°C)", y = "Ritmo (min/km)") +
theme_minimal()## `geom_smooth()` using formula = 'y ~ x'
Notamos una ligera tendencia en forma de U invertida: el ritmo tiende a ser más rápido entre 10–20°C y empeora tanto en frío como en calor extremo. Inferimos con ello que existe y conocemos un rango óptimo de temperatura para el rendimiento.
Activities_final_Analysis$Sex <- factor(Activities_final_Analysis$Sex)
#Busca analizar el efecto de las variables Average.Temperature y Sex sobre el ritmo.
modelo_interactivo <- lm(Pace ~ Average.Temperature * Sex, data = Activities_final_Analysis)
summary(modelo_interactivo)##
## Call:
## lm(formula = Pace ~ Average.Temperature * Sex, data = Activities_final_Analysis)
##
## Residuals:
## Min 1Q Median 3Q Max
## -10.966 -2.741 -0.480 2.299 70.745
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 11.46225 0.45129 25.399 < 2e-16 ***
## Average.Temperature -0.27253 0.01779 -15.317 < 2e-16 ***
## SexMale -3.72215 0.52015 -7.156 9.02e-13 ***
## Average.Temperature:SexMale 0.21288 0.02062 10.324 < 2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 4.059 on 8258 degrees of freedom
## (4457 observations deleted due to missingness)
## Multiple R-squared: 0.06639, Adjusted R-squared: 0.06605
## F-statistic: 195.7 on 3 and 8258 DF, p-value: < 2.2e-16pred <- ggpredict(modelo_interactivo, terms = c("Average.Temperature", "Sex"))
plot(pred) + labs(title = "Predicción del ritmo por temperatura y género")
#Trata de dar a entender cómo cambian los ritmos (más rápidos o lentos) bajo ciertas condiciones.
modelo_q <- rq(Pace ~ Average.Temperature + Distance, data = Activities_final_Analysis, tau = 0.5)
summary(modelo_q)##
## Call: rq(formula = Pace ~ Average.Temperature + Distance, tau = 0.5,
## data = Activities_final_Analysis)
##
## tau: [1] 0.5
##
## Coefficients:
## Value Std. Error t value Pr(>|t|)
## (Intercept) 7.13379 0.22937 31.10127 0.00000
## Average.Temperature -0.07628 0.00872 -8.74940 0.00000
## Distance 0.02427 0.00310 7.83292 0.00000pred_rq <- predict(modelo_q, Activities_final_Analysis)
plot(Activities_final_Analysis$Average.Temperature, pred_rq, type = "l", col = "mediumpurple",
xlab = "Temperatura", ylab = "Ritmo estimado (mediana)",
main = "Regresión cuantílica: ritmo mediano vs temperatura")
# Enmascaramos meses y años. Convertir un número de mes relativo en una etiqueta legible estilo “mes 1 de año 1”.
label_month <- function(m) {
yr <- (m - 1) %/% 12 + 1
mon <- (m - 1) %% 12 + 1
paste0("mes ", mon, " de año ", yr)
}
#Función para calcular la tendencia suave por sexo.Línea central.
safe_gam_pred <- function(dat, yvar, max_m) {
# Aseguramos que la entrada es un dataframe así como la existencia de columnas necesarias.
if (!is.data.frame(dat)) dat <- as.data.frame(dat)
if (!("month_index" %in% names(dat))) return(NULL)
if (!(yvar %in% names(dat))) return(NULL)
# Filtramos sólamente los que no son NAs.
keep <- !is.na(dat$month_index) & !is.na(dat[[yvar]])
dat <- dat[keep, , drop = FALSE]
#Establecemos algunas reglas de ajuste sobre el gráfico, lso datos deben de cumplirlo mínimamente.
if (nrow(dat) < 10) return(NULL)
if (length(unique(dat$month_index)) < 6) return(NULL)
#Parametrizamos la complejidad del suavizado.
k_use <- min(10, max(6, length(unique(dat$month_index)) - 1))
#Construimos fórmula de cálculo y ajuste del modelo a utilizar GAM.
fml <- as.formula(sprintf("%s ~ s(month_index, k = %d)", yvar, k_use))
fit <- mgcv::gam(fml, data = dat, method = "REML")
#Calculamos la tendencia para cada mes.
grid <- data.frame(month_index = 1:max_m)
grid$month_label <- label_month(grid$month_index)
grid$yhat <- as.numeric(predict(fit, newdata = grid))
grid
}
# Construimos función que nos genere un panel mediante plotly.
make_panel_plotly <- function(dat, yvar, ytitle, max_m, show_individual = TRUE,
tickvals, ticktext, show_trend_legend = TRUE) {
#Segmentación de datos por sexo.
dm <- dat %>% filter(Sex == "M")
df <- dat %>% filter(Sex == "F")
p <- plot_ly()
# Configuramos gráfico para que este permita líneas individuales por atleta.
if (show_individual) {
if (nrow(dm) > 0) {
p <- p %>% add_lines(
data = dm,
x = ~month_index, y = as.formula(paste0("~", yvar)),
split = ~Athlete.ID,
line = list(color = "blue", width = 1),
opacity = 0.25,
hovertemplate = paste0(
"Atleta: %{fullData.name}<br>",
"Sexo: M<br>",
"Tiempo: %{customdata}<br>",
ytitle, ": %{y:.2f}<extra></extra>"
),
customdata = ~month_label,
showlegend = FALSE
)
}
if (nrow(df) > 0) {
p <- p %>% add_lines(
data = df,
x = ~month_index, y = as.formula(paste0("~", yvar)),
split = ~Athlete.ID,
line = list(color = "red", width = 1),
opacity = 0.25,
hovertemplate = paste0(
"Atleta: %{fullData.name}<br>",
"Sexo: F<br>",
"Tiempo: %{customdata}<br>",
ytitle, ": %{y:.2f}<extra></extra>"
),
customdata = ~month_label,
showlegend = FALSE
)
}
}
# Calculo de tendencias por sexo predichas mediante función anterior.
pred_m <- safe_gam_pred(dm, yvar, max_m)
pred_f <- safe_gam_pred(df, yvar, max_m)
#Dibujamos las líneas con la predicción por genero.
if (!is.null(pred_m)) {
p <- p %>% add_lines(
data = pred_m,
x = ~month_index, y = ~yhat,
name = "Tendencia M",
showlegend = show_trend_legend,
legendgroup = "tend_m",
line = list(color = "blue", width = 4),
hovertemplate = paste0("Tendencia M<br>Tiempo: %{customdata}<br>", ytitle, ": %{y:.2f}<extra></extra>"),
customdata = ~month_label
)
}
if (!is.null(pred_f)) {
p <- p %>% add_lines(
data = pred_f,
x = ~month_index, y = ~yhat,
name = "Tendencia F",
showlegend = show_trend_legend,
legendgroup = "tend_m",
line = list(color = "red", width = 4),
hovertemplate = paste0("Tendencia F<br>Tiempo: %{customdata}<br>", ytitle, ": %{y:.2f}<extra></extra>"),
customdata = ~month_label
)
}
#Formateo del eje x atendiendo a las etiquetas enmascardas.
p %>%
layout(
yaxis = list(title = ytitle),
xaxis = list(
title = "Tiempo desde cero (meses enmascarados)",
tickmode = "array",
tickvals = tickvals,
ticktext = ticktext,
tickangle = 45
),
hovermode = "closest"
)
}
#Preparación del dataset para poder graficar acorde con lo que pretendemos.
raw <- Activities_final_Analysis %>%
mutate(
date = ymd(Activity.Date_Date),
Athlete.ID = as.factor(Athlete.ID),
#Normalizamos variable Sex en base a dos niveles.
Sex_raw = toupper(as.character(Sex)),
Sex = case_when(
Sex_raw %in% c("M", "MALE", "H", "HOMBRE") ~ "M",
Sex_raw %in% c("F", "FEMALE", "MUJER") ~ "F",
TRUE ~ NA_character_
),
Sex = factor(Sex, levels = c("M", "F")),
#Creamos métricas base.
dist_km = Distance,
mov_hour = Moving.Time / 3600,
elev_gain = Elevation.Gain
) %>%
#filter(!is.na(date), !is.na(Athlete.ID), !is.na(Sex)) %>%
#Filtramos solo actividades implicadas en Carrera.
filter(Activity.Type %in% c("Run")) %>%
mutate(month_date = floor_date(date, "month")) %>%
# Cálculo del inicio de sesiones para cada atleta.
group_by(Athlete.ID) %>%
mutate(
start_month = min(month_date, na.rm = TRUE),
month_index = interval(start_month, month_date) %/% months(1) + 1
) %>%
ungroup()
#Agregación mensual por atleta y sexo con sumatorio de variables clave como distancia,tiempo en movimiento o ganancia de elevación.
monthly_base <- raw %>%
group_by(Athlete.ID, Sex, month_index) %>%
summarise(
dist_km = sum(dist_km, na.rm = TRUE),
mov_hour = sum(mov_hour, na.rm = TRUE),
elev_gain = sum(elev_gain, na.rm = TRUE),
.groups = "drop"
)
# Generamos y configuramos controles visuales para manejar e interactuar con los datos.
ui <- fluidPage(
titlePanel("Evolución desde cero (mensual) por atleta + tendencia por sexo"),
sidebarLayout(
sidebarPanel(
selectizeInput(
"athletes", "Selecciona atletas (vacío = todos):",
choices = sort(unique(as.character(monthly_base$Athlete.ID))),
multiple = TRUE,
options = list(placeholder = "Escribe para buscar...", maxOptions = 2000)
),
radioButtons("sex_filter", "Sexo:", choices = c("Ambos" = "ALL", "Masculino" = "M", "Femenino" = "F"),
selected = "ALL", inline = TRUE),
checkboxInput("fill_zeros", "Rellenar meses sin actividad con 0 (línea continua)", value = TRUE),
checkboxInput("show_individual", "Mostrar líneas individuales por atleta", value = TRUE),
sliderInput("max_months", "Mostrar primeros N meses desde cero:",
min = 6, max = max(monthly_base$month_index, na.rm = TRUE),
value = min(36, max(monthly_base$month_index, na.rm = TRUE)), step = 1),
helpText("Azul = Masculino | Rojo = Femenino. La línea gruesa es tendencia (GAM) por sexo.")
),
mainPanel(
plotlyOutput("evolPlot", height = "850px"),
hr(),
verbatimTextOutput("info")
)
)
)
# Implementamos lógica de funcionamiento del gráfico. Le llamamos servidor o server.
server <- function(input, output, session) {
#Permite recolectar los filtros que ha añadido el usuario para su aplicación posterior.
dat_reactive <- reactive({
d <- monthly_base
# filtro atletas
if (!is.null(input$athletes) && length(input$athletes) > 0) {
d <- d %>% filter(as.character(Athlete.ID) %in% input$athletes)
}
# filtro sexo
if (input$sex_filter != "ALL") {
d <- d %>% filter(Sex == input$sex_filter)
}
# limitar meses
d <- d %>% filter(month_index <= input$max_months)
# completar meses con 0 (opcional)
if (isTRUE(input$fill_zeros)) {
d <- d %>%
group_by(Athlete.ID, Sex) %>%
complete(month_index = 1:input$max_months,
fill = list(dist_km = 0, mov_hour = 0, elev_gain = 0)) %>%
ungroup()
}
d %>% mutate(month_label = label_month(month_index))
})
#Construimos 3 paneles (uno por cada métrica a analizar).
output$evolPlot <- renderPlotly({
dat <- dat_reactive()
validate(need(nrow(dat) > 0, "No hay datos con esos filtros."))
max_m <- input$max_months
# ticks legibles
by_step <- dplyr::case_when(max_m <= 24 ~ 1, max_m <= 48 ~ 2, TRUE ~ 3)
tickvals <- seq(1, max_m, by = by_step)
ticktext <- label_month(tickvals)
p1 <- make_panel_plotly(dat, "dist_km", "Distancia mensual (km)", max_m,
show_individual = isTRUE(input$show_individual),
tickvals = tickvals, ticktext = ticktext
,show_trend_legend = TRUE)
p2 <- make_panel_plotly(dat, "mov_hour", "Tiempo en movimiento mensual (h)", max_m,
show_individual = isTRUE(input$show_individual),
tickvals = tickvals, ticktext = ticktext
,show_trend_legend = FALSE)
p3 <- make_panel_plotly(dat, "elev_gain", "Desnivel+ mensual (m)", max_m,
show_individual = isTRUE(input$show_individual),
tickvals = tickvals, ticktext = ticktext
,show_trend_legend = FALSE)
subplot(p1, p2, p3, nrows = 3, shareX = TRUE, titleY = TRUE) %>%
layout(
legend = list(orientation = "h", x = 0, y = 1.05),
margin = list(l = 60, r = 30, t = 60, b = 80)
)
})
#A modo de ayuda incluimos en el gráfico una especie de consola para mostrar información sobre parámetros actualmente aplicados sobre los gráficos.
output$info <- renderPrint({
dat <- dat_reactive()
list(
atletas_mostrados = n_distinct(dat$Athlete.ID),
meses_mostrados = input$max_months,
sexo = input$sex_filter,
lineas_individuales = input$show_individual,
meses_con_0 = input$fill_zeros
)
})
}
#Lanzamos aplicación interactiva facilitándole parte interacción junto a la lógica a seguir.
#options(shiny.launch.browser = FALSE)
shinyApp(ui, server)Con la finalidad de mejorar la experiencia de uso y tratándose de una aplicación interactiva shiny, se ha exportado la aplicación a un entorno más dinámico. Se encuentra disponible en el siguiente enlace: https://9gi2dw-joraddo.shinyapps.io/TrailAnalytics_GAM/